GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-05-20 08:32:50 -06:00
Code Issues Packages Projects Releases Wiki Activity

added dropFunction

Browse Source
This commit is contained in:
krangelov
2021-09-09 09:47:26 +02:00
parent 0dae265b05
commit 28321cc023
6 changed files with 113 additions and 5 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -116,6 +116,8 @@ foreign import ccall pgf_checkout_revision :: Ptr PgfDB -> Ptr PgfText -> Ptr Pg
foreign import ccall pgf_create_function :: Ptr PgfDB -> Ptr PgfRevision -> Ptr PgfText -> StablePtr Type -> (#type prob_t) -> Ptr PgfMarshaller -> Ptr PgfExn -> IO ()
foreign import ccall pgf_drop_function :: Ptr PgfDB -> Ptr PgfRevision -> Ptr PgfText -> Ptr PgfExn -> IO ()
-----------------------------------------------------------------------
-- Texts

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

@@ -4,6 +4,7 @@ module PGF2.Transactions
, branchPGF
, checkoutPGF
, createFunction
, dropFunction
) where
import PGF2.FFI
@@ -110,3 +111,8 @@ createFunction name ty prob = Transaction $ \c_db c_revision c_exn ->
bracket (newStablePtr ty) freeStablePtr $ \c_ty ->
withForeignPtr marshaller $ \m -> do
pgf_create_function c_db c_revision c_name c_ty prob m c_exn
dropFunction :: Fun -> Transaction ()
dropFunction name = Transaction $ \c_db c_revision c_exn ->
withText name $ \c_name -> do
pgf_drop_function c_db c_revision c_name c_exn

3
src/runtime/haskell/tests/transactions.hs
View File

@@ -12,6 +12,8 @@ main = do
Just gr4 <- checkoutPGF gr1 "master"
Just gr5 <- checkoutPGF gr1 "bar_branch"
gr6 <- modifyPGF gr1 (dropFunction "ind")
runTestTTAndExit $
TestList $
[TestCase (assertEqual "original functions" ["c","ind","s","z"] (functions gr1))
@@ -19,6 +21,7 @@ main = do
,TestCase (assertEqual "branched functions" ["bar","c","ind","s","z"] (functions gr3))
,TestCase (assertEqual "checked-out extended functions" ["c","foo","ind","s","z"] (functions gr4))
,TestCase (assertEqual "checked-out branched functions" ["bar","c","ind","s","z"] (functions gr5))
,TestCase (assertEqual "reduced functions" ["c","s","z"] (functions gr6))
,TestCase (assertEqual "old function type" Nothing (functionType gr1 "foo"))
,TestCase (assertEqual "new function type" (Just ty) (functionType gr2 "foo"))
,TestCase (assertEqual "old function prob" (-log 0) (functionProb gr1 "foo"))