msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests 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; fd = -1;
ms = NULL; ms = NULL;
ref_count = 0;
if (filepath == NULL) { if (filepath == NULL) {
this->filepath = NULL; this->filepath = NULL;

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

@@ -65,6 +65,10 @@ private:
friend class PgfReader; friend class PgfReader;
public: 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(const char* filepath, int flags, int mode);
PGF_INTERNAL_DECL ~PgfDB(); 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(); *revision = pgf.as_object();
} }
db->ref_count++;
return db; return db;
} PGF_API_END } PGF_API_END
@@ -97,6 +98,7 @@ PgfDB *pgf_boot_ngf(const char* pgf_path, const char* ngf_path,
PgfDB::sync(); PgfDB::sync();
} }
db->ref_count++;
return db; return db;
} PGF_API_END } PGF_API_END
@@ -130,6 +132,7 @@ PgfDB *pgf_read_ngf(const char *fpath,
*revision = pgf.as_object(); *revision = pgf.as_object();
} }
db->ref_count++;
return db; return db;
} PGF_API_END } PGF_API_END
@@ -175,6 +178,7 @@ PgfDB *pgf_new_ngf(PgfText *abstract_name,
PgfDB::sync(); PgfDB::sync();
} }
db->ref_count++;
return db; return db;
} PGF_API_END } PGF_API_END
@@ -214,12 +218,6 @@ end:
fclose(out); fclose(out);
} }
PGF_API
void pgf_free(PgfDB *db)
{
delete db;
}
PGF_API_DECL PGF_API_DECL
void pgf_free_revision(PgfDB *db, PgfRevision revision) void pgf_free_revision(PgfDB *db, PgfRevision revision)
{ {
@@ -240,9 +238,14 @@ void pgf_free_revision(PgfDB *db, PgfRevision revision)
PgfPGF::release(pgf); PgfPGF::release(pgf);
PgfDB::free(pgf); PgfDB::free(pgf);
} }
db->ref_count--;
} catch (std::runtime_error& e) { } catch (std::runtime_error& e) {
// silently ignore and hope for the best // silently ignore and hope for the best
} }
if (!db->ref_count)
delete db;
} }
PGF_API PGF_API
@@ -601,6 +604,7 @@ PgfRevision pgf_clone_revision(PgfDB *db, PgfRevision revision,
memcpy(&new_pgf->name, ((name == NULL) ? &pgf->name : name), memcpy(&new_pgf->name, ((name == NULL) ? &pgf->name : name),
sizeof(PgfText)+name_size+1); sizeof(PgfText)+name_size+1);
db->ref_count++;
return new_pgf.as_object(); return new_pgf.as_object();
} PGF_API_END } PGF_API_END
@@ -635,6 +639,7 @@ PgfRevision pgf_checkout_revision(PgfDB *db, PgfText *name,
DB_scope scope(db, WRITER_SCOPE); DB_scope scope(db, WRITER_SCOPE);
ref<PgfPGF> pgf = PgfDB::get_revision(name); ref<PgfPGF> pgf = PgfDB::get_revision(name);
Node<PgfPGF>::add_value_ref(pgf); Node<PgfPGF>::add_value_ref(pgf);
db->ref_count++;
return pgf.as_object(); return pgf.as_object();
} PGF_API_END } 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, PgfDB *db, PgfRevision revision,
PgfExn* err); PgfExn* err);
/* Release the database when it is no longer needed. */ /* Release a revision. If this is the last revision for the given
PGF_API_DECL * database, then the database is released as well. */
void pgf_free(PgfDB *pgf);
PGF_API_DECL PGF_API_DECL
void pgf_free_revision(PgfDB *pgf, PgfRevision revision); 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 -> withCString fpath $ \c_fpath ->
alloca $ \p_revision -> alloca $ \p_revision ->
mask_ $ do 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 c_revision <- peek p_revision
fptr1 <- newForeignPtr pgf_free_fptr c_pgf fptr <- C.newForeignPtr c_revision (pgf_free_revision c_db c_revision)
fptr2 <- C.newForeignPtr c_revision (withForeignPtr fptr1 (\c_db -> pgf_free_revision c_db c_revision)) return (PGF c_db fptr Map.empty)
return (PGF fptr1 fptr2 Map.empty)
-- | Reads a PGF file and stores the unpacked data in an NGF file -- | 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. -- 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 -> withCString ngf_path $ \c_ngf_path ->
alloca $ \p_revision -> alloca $ \p_revision ->
mask_ $ do 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 c_revision <- peek p_revision
fptr1 <- newForeignPtr pgf_free_fptr c_pgf fptr <- C.newForeignPtr c_revision (pgf_free_revision c_db c_revision)
fptr2 <- C.newForeignPtr c_revision (withForeignPtr fptr1 (\c_db -> pgf_free_revision c_db c_revision)) return (PGF c_db fptr Map.empty)
return (PGF fptr1 fptr2 Map.empty)
-- | Reads the grammar from an already booted NGF file. -- | Reads the grammar from an already booted NGF file.
-- The function fails if the file does not exist. -- The function fails if the file does not exist.
@@ -143,9 +141,8 @@ readNGF fpath =
mask_ $ do mask_ $ do
c_db <- withPgfExn "readNGF" (pgf_read_ngf c_fpath p_revision) c_db <- withPgfExn "readNGF" (pgf_read_ngf c_fpath p_revision)
c_revision <- peek p_revision c_revision <- peek p_revision
fptr1 <- newForeignPtr pgf_free_fptr c_db fptr <- C.newForeignPtr c_revision (pgf_free_revision c_db c_revision)
fptr2 <- C.newForeignPtr c_revision (withForeignPtr fptr1 (\c_db -> pgf_free_revision c_db c_revision)) return (PGF c_db fptr Map.empty)
return (PGF fptr1 fptr2 Map.empty)
-- | Creates a new NGF file with a grammar with the given abstract_name. -- | 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 -- Aside from the name, the grammar is otherwise empty but can be later
@@ -159,16 +156,14 @@ newNGF abs_name mb_fpath =
mask_ $ do mask_ $ do
c_db <- withPgfExn "newNGF" (pgf_new_ngf c_abs_name c_fpath p_revision) c_db <- withPgfExn "newNGF" (pgf_new_ngf c_abs_name c_fpath p_revision)
c_revision <- peek p_revision c_revision <- peek p_revision
fptr1 <- newForeignPtr pgf_free_fptr c_db fptr <- C.newForeignPtr c_revision (pgf_free_revision c_db c_revision)
fptr2 <- C.newForeignPtr c_revision (withForeignPtr fptr1 (\c_db -> pgf_free_revision c_db c_revision)) return (PGF c_db fptr Map.empty)
return (PGF fptr1 fptr2 Map.empty)
writePGF :: FilePath -> PGF -> IO () writePGF :: FilePath -> PGF -> IO ()
writePGF fpath p = writePGF fpath p =
withCString fpath $ \c_fpath -> withCString fpath $ \c_fpath ->
withForeignPtr (a_db p) $ \c_db ->
withForeignPtr (revision p) $ \c_revision -> 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 :: PGF -> String
showPGF = error "TODO: showPGF" showPGF = error "TODO: showPGF"
@@ -178,9 +173,8 @@ showPGF = error "TODO: showPGF"
abstractName :: PGF -> AbsName abstractName :: PGF -> AbsName
abstractName p = abstractName p =
unsafePerformIO $ unsafePerformIO $
withForeignPtr (a_db p) $ \c_db ->
withForeignPtr (revision p) $ \c_revision -> 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 peekText c_text
-- | The start category is defined in the grammar with -- | The start category is defined in the grammar with
@@ -192,9 +186,8 @@ startCat :: PGF -> Type
startCat p = startCat p =
unsafePerformIO $ unsafePerformIO $
withForeignPtr unmarshaller $ \u -> withForeignPtr unmarshaller $ \u ->
withForeignPtr (a_db p) $ \c_db ->
withForeignPtr (revision p) $ \c_revision -> do 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 typ <- deRefStablePtr c_typ
freeStablePtr c_typ freeStablePtr c_typ
return typ return typ
@@ -204,10 +197,9 @@ functionType :: PGF -> Fun -> Maybe Type
functionType p fn = functionType p fn =
unsafePerformIO $ unsafePerformIO $
withForeignPtr unmarshaller $ \u -> withForeignPtr unmarshaller $ \u ->
withForeignPtr (a_db p) $ \c_db ->
withForeignPtr (revision p) $ \c_revision -> withForeignPtr (revision p) $ \c_revision ->
withText fn $ \c_fn -> do 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 if c_typ == castPtrToStablePtr nullPtr
then return Nothing then return Nothing
else do typ <- deRefStablePtr c_typ else do typ <- deRefStablePtr c_typ
@@ -218,27 +210,24 @@ functionIsConstructor :: PGF -> Fun -> Bool
functionIsConstructor p fun = functionIsConstructor p fun =
unsafePerformIO $ unsafePerformIO $
withText fun $ \c_fun -> withText fun $ \c_fun ->
withForeignPtr (a_db p) $ \c_db ->
withForeignPtr (revision p) $ \c_revision -> 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) return (res /= 0)
functionProbability :: PGF -> Fun -> Float functionProbability :: PGF -> Fun -> Float
functionProbability p fun = functionProbability p fun =
unsafePerformIO $ unsafePerformIO $
withText fun $ \c_fun -> withText fun $ \c_fun ->
withForeignPtr (a_db p) $ \c_db ->
withForeignPtr (revision p) $ \c_revision -> 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 :: PGF -> Expr -> Float
exprProbability p e = exprProbability p e =
unsafePerformIO $ unsafePerformIO $
withForeignPtr (a_db p) $ \c_db ->
withForeignPtr (revision p) $ \c_revision -> withForeignPtr (revision p) $ \c_revision ->
bracket (newStablePtr e) freeStablePtr $ \c_e -> bracket (newStablePtr e) freeStablePtr $ \c_e ->
withForeignPtr marshaller $ \m -> 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 :: PGF -> Expr -> Type -> Either String Expr
checkExpr = error "TODO: checkExpr" checkExpr = error "TODO: checkExpr"
@@ -503,10 +492,9 @@ categories p =
ref <- newIORef [] ref <- newIORef []
(allocaBytes (#size PgfItor) $ \itor -> (allocaBytes (#size PgfItor) $ \itor ->
bracket (wrapItorCallback (getCategories ref)) freeHaskellFunPtr $ \fptr -> bracket (wrapItorCallback (getCategories ref)) freeHaskellFunPtr $ \fptr ->
withForeignPtr (a_db p) $ \c_db ->
withForeignPtr (revision p) $ \c_revision -> do withForeignPtr (revision p) $ \c_revision -> do
(#poke PgfItor, fn) itor fptr (#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 cs <- readIORef ref
return (reverse cs)) return (reverse cs))
where where
@@ -522,10 +510,9 @@ categoryContext p cat =
withText cat $ \c_cat -> withText cat $ \c_cat ->
alloca $ \p_n_hypos -> alloca $ \p_n_hypos ->
withForeignPtr unmarshaller $ \u -> withForeignPtr unmarshaller $ \u ->
withForeignPtr (a_db p) $ \c_db ->
withForeignPtr (revision p) $ \c_revision -> withForeignPtr (revision p) $ \c_revision ->
mask_ $ do 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 if c_hypos == nullPtr
then return Nothing then return Nothing
else do n_hypos <- peek p_n_hypos else do n_hypos <- peek p_n_hypos
@@ -550,9 +537,8 @@ categoryProbability :: PGF -> Cat -> Float
categoryProbability p cat = categoryProbability p cat =
unsafePerformIO $ unsafePerformIO $
withText cat $ \c_cat -> withText cat $ \c_cat ->
withForeignPtr (a_db p) $ \c_db ->
withForeignPtr (revision p) $ \c_revision -> 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 -- | List of all functions defined in the abstract syntax
functions :: PGF -> [Fun] functions :: PGF -> [Fun]
@@ -561,10 +547,9 @@ functions p =
ref <- newIORef [] ref <- newIORef []
(allocaBytes (#size PgfItor) $ \itor -> (allocaBytes (#size PgfItor) $ \itor ->
bracket (wrapItorCallback (getFunctions ref)) freeHaskellFunPtr $ \fptr -> bracket (wrapItorCallback (getFunctions ref)) freeHaskellFunPtr $ \fptr ->
withForeignPtr (a_db p) $ \c_db ->
withForeignPtr (revision p) $ \c_revision -> do withForeignPtr (revision p) $ \c_revision -> do
(#poke PgfItor, fn) itor fptr (#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 fs <- readIORef ref
return (reverse fs)) return (reverse fs))
where where
@@ -582,10 +567,9 @@ functionsByCat p cat =
(withText cat $ \c_cat -> (withText cat $ \c_cat ->
allocaBytes (#size PgfItor) $ \itor -> allocaBytes (#size PgfItor) $ \itor ->
bracket (wrapItorCallback (getFunctions ref)) freeHaskellFunPtr $ \fptr -> bracket (wrapItorCallback (getFunctions ref)) freeHaskellFunPtr $ \fptr ->
withForeignPtr (a_db p) $ \c_db ->
withForeignPtr (revision p) $ \c_revision -> do withForeignPtr (revision p) $ \c_revision -> do
(#poke PgfItor, fn) itor fptr (#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 fs <- readIORef ref
return (reverse fs)) return (reverse fs))
where where
@@ -599,10 +583,9 @@ globalFlag :: PGF -> String -> Maybe Literal
globalFlag p name = globalFlag p name =
unsafePerformIO $ unsafePerformIO $
withText name $ \c_name -> withText name $ \c_name ->
withForeignPtr (a_db p) $ \c_db ->
withForeignPtr (revision p) $ \c_revision -> withForeignPtr (revision p) $ \c_revision ->
withForeignPtr unmarshaller $ \u -> do 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 if c_lit == castPtrToStablePtr nullPtr
then return Nothing then return Nothing
else do lit <- deRefStablePtr c_lit else do lit <- deRefStablePtr c_lit
@@ -613,10 +596,9 @@ abstractFlag :: PGF -> String -> Maybe Literal
abstractFlag p name = abstractFlag p name =
unsafePerformIO $ unsafePerformIO $
withText name $ \c_name -> withText name $ \c_name ->
withForeignPtr (a_db p) $ \c_db ->
withForeignPtr (revision p) $ \c_revision -> withForeignPtr (revision p) $ \c_revision ->
withForeignPtr unmarshaller $ \u -> do 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 if c_lit == castPtrToStablePtr nullPtr
then return Nothing then return Nothing
else do lit <- deRefStablePtr c_lit 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 -- | An abstract data type representing multilingual grammar
-- in Portable Grammar Format. -- in Portable Grammar Format.
data PGF = PGF { a_db :: ForeignPtr PgfDB data PGF = PGF { a_db :: Ptr PgfDB
, revision :: ForeignPtr PgfRevision , revision :: ForeignPtr PgfRevision
, languages:: Map.Map ConcName Concr , 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 -- 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_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" foreign import ccall "pgf_free_revision"
pgf_free_revision :: Ptr PgfDB -> Ptr PgfRevision -> IO () 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_ :: Ptr PgfText -> PGF -> Transaction a -> IO PGF
branchPGF_ c_name p (Transaction f) = branchPGF_ c_name p (Transaction f) =
withForeignPtr (a_db p) $ \c_db ->
withForeignPtr (revision p) $ \c_revision -> withForeignPtr (revision p) $ \c_revision ->
withPgfExn "branchPGF" $ \c_exn -> withPgfExn "branchPGF" $ \c_exn ->
mask $ \restore -> do 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 ex_type <- (#peek PgfExn, type) c_exn
if (ex_type :: (#type PgfExnType)) == (#const PGF_EXN_NONE) 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` `catch`
(\e -> do (\e -> do
pgf_free_revision c_db c_revision pgf_free_revision (a_db p) c_revision
throwIO (e :: SomeException))) throwIO (e :: SomeException)))
ex_type <- (#peek PgfExn, type) c_exn ex_type <- (#peek PgfExn, type) c_exn
if (ex_type :: (#type PgfExnType)) == (#const PGF_EXN_NONE) 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 ex_type <- (#peek PgfExn, type) c_exn
if (ex_type :: (#type PgfExnType)) == (#const PGF_EXN_NONE) 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)) then do fptr <- C.newForeignPtr c_revision (pgf_free_revision (a_db p) c_revision)
return (PGF (a_db p) fptr2 (languages p)) return (PGF (a_db p) fptr (languages p))
else do pgf_free_revision c_db c_revision else do pgf_free_revision (a_db p) c_revision
return p return p
else do pgf_free_revision c_db c_revision else do pgf_free_revision (a_db p) c_revision
return p return p
else return p else return p
{- | Retrieves the branch with the given name -} {- | Retrieves the branch with the given name -}
checkoutPGF :: PGF -> String -> IO (Maybe PGF) checkoutPGF :: PGF -> String -> IO (Maybe PGF)
checkoutPGF p name = checkoutPGF p name =
withForeignPtr (a_db p) $ \c_db ->
withText name $ \c_name -> do 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 if c_revision == nullPtr
then return Nothing then return Nothing
else do fptr2 <- C.newForeignPtr c_revision (withForeignPtr (a_db p) (\c_db -> pgf_free_revision c_db c_revision)) else do fptr <- C.newForeignPtr c_revision (pgf_free_revision (a_db p) c_revision)
return (Just (PGF (a_db p) fptr2 (languages p))) return (Just (PGF (a_db p) fptr (languages p)))
createFunction :: Fun -> Type -> Int -> Float -> Transaction () createFunction :: Fun -> Type -> Int -> Float -> Transaction ()
createFunction name ty arity prob = Transaction $ \c_db c_revision c_exn -> 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 static void
PGF_dealloc(PGFObject *self) PGF_dealloc(PGFObject *self)
{ {
pgf_free(self->db); pgf_free_revision(self->db, self->revision);
Py_TYPE(self)->tp_free((PyObject *)self); Py_TYPE(self)->tp_free((PyObject *)self);
} }