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

use newForeignPtrEnv instead of Foreign.Concurrent.newForeignPtr

Browse Source
This commit is contained in:
krangelov
2021-10-26 20:24:35 +02:00
parent 611fe95322
commit 7e0fc159ce
3 changed files with 12 additions and 12 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -96,7 +96,6 @@ import Foreign.C
import Control.Exception(mask_,bracket)
import System.IO.Unsafe(unsafePerformIO)
import System.Random
import qualified Foreign.Concurrent as C
import qualified Data.Map as Map
import Data.IORef
import Data.List(intersperse,groupBy)
@@ -114,7 +113,7 @@ readPGF fpath =
mask_ $ do
c_db <- withPgfExn "readPGF" (pgf_read_pgf c_fpath p_revision)
c_revision <- peek p_revision
fptr <- C.newForeignPtr c_revision (pgf_free_revision c_db c_revision)
fptr <- newForeignPtrEnv pgf_free_revision c_db c_revision
langs <- getConcretes c_db fptr
return (PGF c_db fptr langs)
@@ -130,7 +129,7 @@ bootNGF pgf_path ngf_path =
mask_ $ do
c_db <- withPgfExn "bootNGF" (pgf_boot_ngf c_pgf_path c_ngf_path p_revision)
c_revision <- peek p_revision
fptr <- C.newForeignPtr c_revision (pgf_free_revision c_db c_revision)
fptr <- newForeignPtrEnv pgf_free_revision c_db c_revision
langs <- getConcretes c_db fptr
return (PGF c_db fptr langs)
@@ -143,7 +142,7 @@ readNGF fpath =
mask_ $ do
c_db <- withPgfExn "readNGF" (pgf_read_ngf c_fpath p_revision)
c_revision <- peek p_revision
fptr <- C.newForeignPtr c_revision (pgf_free_revision c_db c_revision)
fptr <- newForeignPtrEnv pgf_free_revision c_db c_revision
langs <- getConcretes c_db fptr
return (PGF c_db fptr langs)
@@ -159,7 +158,7 @@ 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
fptr <- C.newForeignPtr c_revision (pgf_free_revision c_db c_revision)
fptr <- newForeignPtrEnv pgf_free_revision c_db c_revision
return (PGF c_db fptr Map.empty)
writePGF :: FilePath -> PGF -> IO ()

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

@@ -63,7 +63,9 @@ foreign import ccall pgf_new_ngf :: Ptr PgfText -> CString -> Ptr (Ptr (PgfRevis
foreign import ccall pgf_write_pgf :: CString -> Ptr PgfDB -> Ptr (PgfRevision PGF) -> Ptr PgfExn -> IO ()
foreign import ccall pgf_free_revision :: Ptr PgfDB -> Ptr (PgfRevision PGF) -> IO ()
foreign import ccall "pgf_free_revision" pgf_free_revision_ :: Ptr PgfDB -> Ptr (PgfRevision PGF) -> IO ()
foreign import ccall "&pgf_free_revision" pgf_free_revision :: FinalizerEnvPtr PgfDB (PgfRevision PGF)
foreign import ccall pgf_free_concr_revision :: Ptr PgfDB -> Ptr (PgfRevision Concr) -> IO ()

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

@@ -24,7 +24,6 @@ import PGF2.Expr
import Foreign
import Foreign.C
import qualified Foreign.Concurrent as C
import Control.Exception
#include <pgf/pgf.h>
@@ -90,19 +89,19 @@ branchPGF_ c_name p (Transaction f) =
then do ((restore (f (a_db p) c_revision c_exn))
`catch`
(\e -> do
pgf_free_revision (a_db p) 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 (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 fptr <- C.newForeignPtr c_revision (pgf_free_revision (a_db p) c_revision)
then do fptr <- newForeignPtrEnv pgf_free_revision (a_db p) c_revision
langs <- getConcretes (a_db p) fptr
return (PGF (a_db p) fptr langs)
else do pgf_free_revision (a_db p) c_revision
else do pgf_free_revision_ (a_db p) c_revision
return p
else do pgf_free_revision (a_db p) c_revision
else do pgf_free_revision_ (a_db p) c_revision
return p
else return p
@@ -113,7 +112,7 @@ checkoutPGF p name =
c_revision <- withPgfExn "checkoutPGF" (pgf_checkout_revision (a_db p) c_name)
if c_revision == nullPtr
then return Nothing
else do fptr <- C.newForeignPtr c_revision (pgf_free_revision (a_db p) c_revision)
else do fptr <- newForeignPtrEnv pgf_free_revision (a_db p) c_revision
langs <- getConcretes (a_db p) fptr
return (Just (PGF (a_db p) fptr langs))