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

introduce probspace and maintain consistency after delete

Browse Source
This commit is contained in:
Krasimir Angelov
2023-03-02 09:40:39 +01:00
parent 23a5a3cdef
commit 8fc73b5d05
11 changed files with 359 additions and 102 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -233,11 +233,11 @@ foreign import ccall "dynamic" callLinBuilder7 :: Dynamic (Ptr PgfLinBuilderIfac
foreign import ccall pgf_create_lincat :: Ptr PgfDB -> Ptr PGF -> Ptr Concr -> Ptr PgfText -> CSize -> Ptr (Ptr PgfText) -> CSize -> CSize -> Ptr PgfBuildLinIface -> Ptr PgfExn -> IO ()
foreign import ccall pgf_drop_lincat :: Ptr PgfDB -> Ptr Concr -> Ptr PgfText -> Ptr PgfExn -> IO ()
foreign import ccall pgf_drop_lincat :: Ptr PgfDB -> Ptr PGF -> Ptr Concr -> Ptr PgfText -> Ptr PgfExn -> IO ()
foreign import ccall pgf_create_lin :: Ptr PgfDB -> Ptr PGF -> Ptr Concr -> Ptr PgfText -> CSize -> Ptr PgfBuildLinIface -> Ptr PgfExn -> IO ()
foreign import ccall pgf_drop_lin :: Ptr PgfDB -> Ptr Concr -> Ptr PgfText -> Ptr PgfExn -> IO ()
foreign import ccall pgf_drop_lin :: Ptr PgfDB -> Ptr PGF -> Ptr Concr -> Ptr PgfText -> Ptr PgfExn -> IO ()
foreign import ccall pgf_has_linearization :: Ptr PgfDB -> Ptr Concr -> Ptr PgfText -> Ptr PgfExn -> IO CInt
@@ -371,7 +371,7 @@ utf8Length s = count 0 s
-- Exceptions
data PGFError = PGFError String String
deriving Typeable
deriving (Eq,Typeable)
instance Show PGFError where
show (PGFError loc msg) = loc++": "++msg

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

@@ -150,6 +150,8 @@ checkoutPGF p = do
contains %d, %x or %a then the pattern is replaced with a random
number in base 10, 16, or 36, which guarantees that the name is
unique. The returned name is the final name after the substitution.
If there is no substitution pattern in the name, and there is
already a function with the same name then an exception is thrown.
-}
createFunction :: Fun -> Type -> Int -> [[Instr]] -> Float -> Transaction PGF Fun
createFunction name ty arity bytecode prob = Transaction $ \c_db _ c_revision c_exn ->
@@ -284,9 +286,9 @@ createLincat name fields lindefs linrefs seqtbl = Transaction $ \c_db c_abstr c_
withTexts p (i+1) ss f
dropLincat :: Cat -> Transaction Concr ()
dropLincat name = Transaction $ \c_db _ c_revision c_exn ->
dropLincat name = Transaction $ \c_db c_abstr c_revision c_exn ->
withText name $ \c_name ->
pgf_drop_lincat c_db c_revision c_name c_exn
pgf_drop_lincat c_db c_abstr c_revision c_name c_exn
createLin :: Fun -> [Production] -> SeqTable -> Transaction Concr SeqTable
createLin name prods seqtbl = Transaction $ \c_db c_abstr c_revision c_exn ->
@@ -406,9 +408,9 @@ withBuildLinIface prods seqtbl f = do
pokeTerms (c_terms `plusPtr` (2*(#size size_t))) terms
dropLin :: Fun -> Transaction Concr ()
dropLin name = Transaction $ \c_db _ c_revision c_exn ->
dropLin name = Transaction $ \c_db c_abstr c_revision c_exn ->
withText name $ \c_name ->
pgf_drop_lin c_db c_revision c_name c_exn
pgf_drop_lin c_db c_abstr c_revision c_name c_exn
setPrintName :: Fun -> String -> Transaction Concr ()
setPrintName fun name = Transaction $ \c_db _ c_revision c_exn ->