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

merge pgf_free and pgf_free_revision since otherwise we cannot control the finalizers in Haskell

Browse Source
This commit is contained in:
krangelov
2021-09-22 13:21:07 +02:00
parent 74c63b196f
commit e11e775a96
8 changed files with 56 additions and 71 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
src/runtime/c/pgf/db.cxx
View File

@@ -289,6 +289,7 @@ PgfDB::PgfDB(const char* filepath, int flags, int mode) {
fd = -1;
ms = NULL;
ref_count = 0;
if (filepath == NULL) {
this->filepath = NULL;

4
src/runtime/c/pgf/db.h
View File

@@ -65,6 +65,10 @@ private:
friend class PgfReader;
public:
// Here we count to how many revisions the client has access.
// When the count is zero we release the database.
int ref_count;
PGF_INTERNAL_DECL PgfDB(const char* filepath, int flags, int mode);
PGF_INTERNAL_DECL ~PgfDB();

17
src/runtime/c/pgf/pgf.cxx
View File

@@ -56,6 +56,7 @@ PgfDB *pgf_read_pgf(const char* fpath,
*revision = pgf.as_object();
}
db->ref_count++;
return db;
} PGF_API_END
@@ -97,6 +98,7 @@ PgfDB *pgf_boot_ngf(const char* pgf_path, const char* ngf_path,
PgfDB::sync();
}
db->ref_count++;
return db;
} PGF_API_END
@@ -130,6 +132,7 @@ PgfDB *pgf_read_ngf(const char *fpath,
*revision = pgf.as_object();
}
db->ref_count++;
return db;
} PGF_API_END
@@ -175,6 +178,7 @@ PgfDB *pgf_new_ngf(PgfText *abstract_name,
PgfDB::sync();
}
db->ref_count++;
return db;
} PGF_API_END
@@ -214,12 +218,6 @@ end:
fclose(out);
}
PGF_API
void pgf_free(PgfDB *db)
{
delete db;
}
PGF_API_DECL
void pgf_free_revision(PgfDB *db, PgfRevision revision)
{
@@ -240,9 +238,14 @@ void pgf_free_revision(PgfDB *db, PgfRevision revision)
PgfPGF::release(pgf);
PgfDB::free(pgf);
}
db->ref_count--;
} catch (std::runtime_error& e) {
// silently ignore and hope for the best
}
if (!db->ref_count)
delete db;
}
PGF_API
@@ -601,6 +604,7 @@ PgfRevision pgf_clone_revision(PgfDB *db, PgfRevision revision,
memcpy(&new_pgf->name, ((name == NULL) ? &pgf->name : name),
sizeof(PgfText)+name_size+1);
db->ref_count++;
return new_pgf.as_object();
} PGF_API_END
@@ -635,6 +639,7 @@ PgfRevision pgf_checkout_revision(PgfDB *db, PgfText *name,
DB_scope scope(db, WRITER_SCOPE);
ref<PgfPGF> pgf = PgfDB::get_revision(name);
Node<PgfPGF>::add_value_ref(pgf);
db->ref_count++;
return pgf.as_object();
} PGF_API_END

6
src/runtime/c/pgf/pgf.h
View File

@@ -259,10 +259,8 @@ void pgf_write_pgf(const char* fpath,
PgfDB *db, PgfRevision revision,
PgfExn* err);
/* Release the database when it is no longer needed. */
PGF_API_DECL
void pgf_free(PgfDB *pgf);
/* Release a revision. If this is the last revision for the given
* database, then the database is released as well. */
PGF_API_DECL
void pgf_free_revision(PgfDB *pgf, PgfRevision revision);

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

@@ -112,11 +112,10 @@ readPGF fpath =
withCString fpath $ \c_fpath ->
alloca $ \p_revision ->
mask_ $ do
c_pgf <- withPgfExn "readPGF" (pgf_read_pgf c_fpath p_revision)
c_db <- withPgfExn "readPGF" (pgf_read_pgf c_fpath p_revision)
c_revision <- peek p_revision
fptr1 <- newForeignPtr pgf_free_fptr c_pgf
fptr2 <- C.newForeignPtr c_revision (withForeignPtr fptr1 (\c_db -> pgf_free_revision c_db c_revision))
return (PGF fptr1 fptr2 Map.empty)
fptr <- C.newForeignPtr c_revision (pgf_free_revision c_db c_revision)
return (PGF c_db fptr Map.empty)
-- | Reads a PGF file and stores the unpacked data in an NGF file
-- ready to be shared with other process, or used for quick startup.
@@ -128,11 +127,10 @@ bootNGF pgf_path ngf_path =
withCString ngf_path $ \c_ngf_path ->
alloca $ \p_revision ->
mask_ $ do
c_pgf <- withPgfExn "bootNGF" (pgf_boot_ngf c_pgf_path c_ngf_path p_revision)
c_db <- withPgfExn "bootNGF" (pgf_boot_ngf c_pgf_path c_ngf_path p_revision)
c_revision <- peek p_revision
fptr1 <- newForeignPtr pgf_free_fptr c_pgf
fptr2 <- C.newForeignPtr c_revision (withForeignPtr fptr1 (\c_db -> pgf_free_revision c_db c_revision))
return (PGF fptr1 fptr2 Map.empty)
fptr <- C.newForeignPtr c_revision (pgf_free_revision c_db c_revision)
return (PGF c_db fptr Map.empty)
-- | Reads the grammar from an already booted NGF file.
-- The function fails if the file does not exist.
@@ -143,9 +141,8 @@ readNGF fpath =
mask_ $ do
c_db <- withPgfExn "readNGF" (pgf_read_ngf c_fpath p_revision)
c_revision <- peek p_revision
fptr1 <- newForeignPtr pgf_free_fptr c_db
fptr2 <- C.newForeignPtr c_revision (withForeignPtr fptr1 (\c_db -> pgf_free_revision c_db c_revision))
return (PGF fptr1 fptr2 Map.empty)
fptr <- C.newForeignPtr c_revision (pgf_free_revision c_db c_revision)
return (PGF c_db fptr Map.empty)
-- | Creates a new NGF file with a grammar with the given abstract_name.
-- Aside from the name, the grammar is otherwise empty but can be later
@@ -159,16 +156,14 @@ newNGF abs_name mb_fpath =
mask_ $ do
c_db <- withPgfExn "newNGF" (pgf_new_ngf c_abs_name c_fpath p_revision)
c_revision <- peek p_revision
fptr1 <- newForeignPtr pgf_free_fptr c_db
fptr2 <- C.newForeignPtr c_revision (withForeignPtr fptr1 (\c_db -> pgf_free_revision c_db c_revision))
return (PGF fptr1 fptr2 Map.empty)
fptr <- C.newForeignPtr c_revision (pgf_free_revision c_db c_revision)
return (PGF c_db fptr Map.empty)
writePGF :: FilePath -> PGF -> IO ()
writePGF fpath p =
withCString fpath $ \c_fpath ->
withForeignPtr (a_db p) $ \c_db ->
withForeignPtr (revision p) $ \c_revision ->
withPgfExn "writePGF" (pgf_write_pgf c_fpath c_db c_revision)
withPgfExn "writePGF" (pgf_write_pgf c_fpath (a_db p) c_revision)
showPGF :: PGF -> String
showPGF = error "TODO: showPGF"
@@ -178,9 +173,8 @@ showPGF = error "TODO: showPGF"
abstractName :: PGF -> AbsName
abstractName p =
unsafePerformIO $
withForeignPtr (a_db p) $ \c_db ->
withForeignPtr (revision p) $ \c_revision ->
bracket (withPgfExn "abstractName" (pgf_abstract_name c_db c_revision)) free $ \c_text ->
bracket (withPgfExn "abstractName" (pgf_abstract_name (a_db p) c_revision)) free $ \c_text ->
peekText c_text
-- | The start category is defined in the grammar with
@@ -192,9 +186,8 @@ startCat :: PGF -> Type
startCat p =
unsafePerformIO $
withForeignPtr unmarshaller $ \u ->
withForeignPtr (a_db p) $ \c_db ->
withForeignPtr (revision p) $ \c_revision -> do
c_typ <- withPgfExn "startCat" (pgf_start_cat c_db c_revision u)
c_typ <- withPgfExn "startCat" (pgf_start_cat (a_db p) c_revision u)
typ <- deRefStablePtr c_typ
freeStablePtr c_typ
return typ
@@ -204,10 +197,9 @@ functionType :: PGF -> Fun -> Maybe Type
functionType p fn =
unsafePerformIO $
withForeignPtr unmarshaller $ \u ->
withForeignPtr (a_db p) $ \c_db ->
withForeignPtr (revision p) $ \c_revision ->
withText fn $ \c_fn -> do
c_typ <- withPgfExn "functionType" (pgf_function_type c_db c_revision c_fn u)
c_typ <- withPgfExn "functionType" (pgf_function_type (a_db p) c_revision c_fn u)
if c_typ == castPtrToStablePtr nullPtr
then return Nothing
else do typ <- deRefStablePtr c_typ
@@ -218,27 +210,24 @@ functionIsConstructor :: PGF -> Fun -> Bool
functionIsConstructor p fun =
unsafePerformIO $
withText fun $ \c_fun ->
withForeignPtr (a_db p) $ \c_db ->
withForeignPtr (revision p) $ \c_revision ->
do res <- withPgfExn "functionIsConstructor" (pgf_function_is_constructor c_db c_revision c_fun)
do res <- withPgfExn "functionIsConstructor" (pgf_function_is_constructor (a_db p) c_revision c_fun)
return (res /= 0)
functionProbability :: PGF -> Fun -> Float
functionProbability p fun =
unsafePerformIO $
withText fun $ \c_fun ->
withForeignPtr (a_db p) $ \c_db ->
withForeignPtr (revision p) $ \c_revision ->
withPgfExn "functionProbability" (pgf_function_prob c_db c_revision c_fun)
withPgfExn "functionProbability" (pgf_function_prob (a_db p) c_revision c_fun)
exprProbability :: PGF -> Expr -> Float
exprProbability p e =
unsafePerformIO $
withForeignPtr (a_db p) $ \c_db ->
withForeignPtr (revision p) $ \c_revision ->
bracket (newStablePtr e) freeStablePtr $ \c_e ->
withForeignPtr marshaller $ \m ->
withPgfExn "exprProbability" (pgf_expr_prob c_db c_revision c_e m)
withPgfExn "exprProbability" (pgf_expr_prob (a_db p) c_revision c_e m)
checkExpr :: PGF -> Expr -> Type -> Either String Expr
checkExpr = error "TODO: checkExpr"
@@ -503,10 +492,9 @@ categories p =
ref <- newIORef []
(allocaBytes (#size PgfItor) $ \itor ->
bracket (wrapItorCallback (getCategories ref)) freeHaskellFunPtr $ \fptr ->
withForeignPtr (a_db p) $ \c_db ->
withForeignPtr (revision p) $ \c_revision -> do
(#poke PgfItor, fn) itor fptr
withPgfExn "categories" (pgf_iter_categories c_db c_revision itor)
withPgfExn "categories" (pgf_iter_categories (a_db p) c_revision itor)
cs <- readIORef ref
return (reverse cs))
where
@@ -522,10 +510,9 @@ categoryContext p cat =
withText cat $ \c_cat ->
alloca $ \p_n_hypos ->
withForeignPtr unmarshaller $ \u ->
withForeignPtr (a_db p) $ \c_db ->
withForeignPtr (revision p) $ \c_revision ->
mask_ $ do
c_hypos <- withPgfExn "categoryContext" (pgf_category_context c_db c_revision c_cat p_n_hypos u)
c_hypos <- withPgfExn "categoryContext" (pgf_category_context (a_db p) c_revision c_cat p_n_hypos u)
if c_hypos == nullPtr
then return Nothing
else do n_hypos <- peek p_n_hypos
@@ -550,9 +537,8 @@ categoryProbability :: PGF -> Cat -> Float
categoryProbability p cat =
unsafePerformIO $
withText cat $ \c_cat ->
withForeignPtr (a_db p) $ \c_db ->
withForeignPtr (revision p) $ \c_revision ->
withPgfExn "categoryProbability" (pgf_category_prob c_db c_revision c_cat)
withPgfExn "categoryProbability" (pgf_category_prob (a_db p) c_revision c_cat)
-- | List of all functions defined in the abstract syntax
functions :: PGF -> [Fun]
@@ -561,10 +547,9 @@ functions p =
ref <- newIORef []
(allocaBytes (#size PgfItor) $ \itor ->
bracket (wrapItorCallback (getFunctions ref)) freeHaskellFunPtr $ \fptr ->
withForeignPtr (a_db p) $ \c_db ->
withForeignPtr (revision p) $ \c_revision -> do
(#poke PgfItor, fn) itor fptr
withPgfExn "functions" (pgf_iter_functions c_db c_revision itor)
withPgfExn "functions" (pgf_iter_functions (a_db p) c_revision itor)
fs <- readIORef ref
return (reverse fs))
where
@@ -582,10 +567,9 @@ functionsByCat p cat =
(withText cat $ \c_cat ->
allocaBytes (#size PgfItor) $ \itor ->
bracket (wrapItorCallback (getFunctions ref)) freeHaskellFunPtr $ \fptr ->
withForeignPtr (a_db p) $ \c_db ->
withForeignPtr (revision p) $ \c_revision -> do
(#poke PgfItor, fn) itor fptr
withPgfExn "functionsByCat" (pgf_iter_functions_by_cat c_db c_revision c_cat itor)
withPgfExn "functionsByCat" (pgf_iter_functions_by_cat (a_db p) c_revision c_cat itor)
fs <- readIORef ref
return (reverse fs))
where
@@ -599,10 +583,9 @@ globalFlag :: PGF -> String -> Maybe Literal
globalFlag p name =
unsafePerformIO $
withText name $ \c_name ->
withForeignPtr (a_db p) $ \c_db ->
withForeignPtr (revision p) $ \c_revision ->
withForeignPtr unmarshaller $ \u -> do
c_lit <- withPgfExn "globalFlag" (pgf_get_global_flag c_db c_revision c_name u)
c_lit <- withPgfExn "globalFlag" (pgf_get_global_flag (a_db p) c_revision c_name u)
if c_lit == castPtrToStablePtr nullPtr
then return Nothing
else do lit <- deRefStablePtr c_lit
@@ -613,10 +596,9 @@ abstractFlag :: PGF -> String -> Maybe Literal
abstractFlag p name =
unsafePerformIO $
withText name $ \c_name ->
withForeignPtr (a_db p) $ \c_db ->
withForeignPtr (revision p) $ \c_revision ->
withForeignPtr unmarshaller $ \u -> do
c_lit <- withPgfExn "abstractFlag" (pgf_get_abstract_flag c_db c_revision c_name u)
c_lit <- withPgfExn "abstractFlag" (pgf_get_abstract_flag (a_db p) c_revision c_name u)
if c_lit == castPtrToStablePtr nullPtr
then return Nothing
else do lit <- deRefStablePtr c_lit

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

@@ -23,11 +23,11 @@ type ConcName = String -- ^ Name of concrete syntax
-- | An abstract data type representing multilingual grammar
-- in Portable Grammar Format.
data PGF = PGF { a_db :: ForeignPtr PgfDB
data PGF = PGF { a_db :: Ptr PgfDB
, revision :: ForeignPtr PgfRevision
, languages:: Map.Map ConcName Concr
}
data Concr = Concr {c_pgf :: ForeignPtr PgfDB, concr :: Ptr PgfConcr}
data Concr = Concr {c_pgf :: Ptr PgfDB, concr :: Ptr PgfConcr}
------------------------------------------------------------------
-- libpgf API
@@ -62,9 +62,6 @@ foreign import ccall pgf_new_ngf :: Ptr PgfText -> CString -> Ptr (Ptr PgfRevisi
foreign import ccall pgf_write_pgf :: CString -> Ptr PgfDB -> Ptr PgfRevision -> Ptr PgfExn -> IO ()
foreign import ccall "&pgf_free"
pgf_free_fptr :: FinalizerPtr PgfDB
foreign import ccall "pgf_free_revision"
pgf_free_revision :: Ptr PgfDB -> Ptr PgfRevision -> IO ()

24
src/runtime/haskell/PGF2/Transactions.hsc
View File

@@ -73,41 +73,39 @@ branchPGF p name t =
branchPGF_ :: Ptr PgfText -> PGF -> Transaction a -> IO PGF
branchPGF_ c_name p (Transaction f) =
withForeignPtr (a_db p) $ \c_db ->
withForeignPtr (revision p) $ \c_revision ->
withPgfExn "branchPGF" $ \c_exn ->
mask $ \restore -> do
c_revision <- pgf_clone_revision c_db c_revision c_name c_exn
c_revision <- pgf_clone_revision (a_db p) c_revision c_name c_exn
ex_type <- (#peek PgfExn, type) c_exn
if (ex_type :: (#type PgfExnType)) == (#const PGF_EXN_NONE)
then do ((restore (f c_db c_revision c_exn))
then do ((restore (f (a_db p) c_revision c_exn))
`catch`
(\e -> do
pgf_free_revision c_db c_revision
pgf_free_revision (a_db p) c_revision
throwIO (e :: SomeException)))
ex_type <- (#peek PgfExn, type) c_exn
if (ex_type :: (#type PgfExnType)) == (#const PGF_EXN_NONE)
then do pgf_commit_revision c_db c_revision c_exn
then do pgf_commit_revision (a_db p) c_revision c_exn
ex_type <- (#peek PgfExn, type) c_exn
if (ex_type :: (#type PgfExnType)) == (#const PGF_EXN_NONE)
then do fptr2 <- C.newForeignPtr c_revision (withForeignPtr (a_db p) (\c_db -> pgf_free_revision c_db c_revision))
return (PGF (a_db p) fptr2 (languages p))
else do pgf_free_revision c_db c_revision
then do fptr <- C.newForeignPtr c_revision (pgf_free_revision (a_db p) c_revision)
return (PGF (a_db p) fptr (languages p))
else do pgf_free_revision (a_db p) c_revision
return p
else do pgf_free_revision c_db c_revision
else do pgf_free_revision (a_db p) c_revision
return p
else return p
{- | Retrieves the branch with the given name -}
checkoutPGF :: PGF -> String -> IO (Maybe PGF)
checkoutPGF p name =
withForeignPtr (a_db p) $ \c_db ->
withText name $ \c_name -> do
c_revision <- withPgfExn "checkoutPGF" (pgf_checkout_revision c_db c_name)
c_revision <- withPgfExn "checkoutPGF" (pgf_checkout_revision (a_db p) c_name)
if c_revision == nullPtr
then return Nothing
else do fptr2 <- C.newForeignPtr c_revision (withForeignPtr (a_db p) (\c_db -> pgf_free_revision c_db c_revision))
return (Just (PGF (a_db p) fptr2 (languages p)))
else do fptr <- C.newForeignPtr c_revision (pgf_free_revision (a_db p) c_revision)
return (Just (PGF (a_db p) fptr (languages p)))
createFunction :: Fun -> Type -> Int -> Float -> Transaction ()
createFunction name ty arity prob = Transaction $ \c_db c_revision c_exn ->

2
src/runtime/python/pypgf.c
View File

@@ -13,7 +13,7 @@
static void
PGF_dealloc(PGFObject *self)
{
pgf_free(self->db);
pgf_free_revision(self->db, self->revision);
Py_TYPE(self)->tp_free((PyObject *)self);
}