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

working fullFormLexicon. Slows down loading and compilation

Browse Source
This commit is contained in:
Krasimir Angelov
2022-02-08 16:38:30 +01:00
parent fc7c1249b0
commit 4d240f7260
13 changed files with 581 additions and 195 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -294,7 +294,7 @@ showPGF p =
bracket (wrapSequenceItorCallback (getSequences ref)) freeHaskellFunPtr $ \fptr ->
withForeignPtr (c_revision c) $ \c_revision -> do
(#poke PgfSequenceItor, fn) itor fptr
withPgfExn "showPGF" (pgf_iter_sequences (a_db p) c_revision itor))
withPgfExn "showPGF" (pgf_iter_sequences (a_db p) c_revision itor nullPtr))
doc <- readIORef ref
return (seq_ids, doc)
where
@@ -303,6 +303,7 @@ showPGF p =
def <- bracket (pgf_print_sequence_internal seq_id val) free $ \c_text -> do
fmap text (peekText c_text)
modifyIORef ref $ (\doc -> doc $$ def)
return 0
-- | The abstract language name is the name of the top-level
-- abstract module
@@ -570,20 +571,33 @@ unk _ _ = False
fullFormLexicon :: Concr -> [(String, [MorphoAnalysis])]
fullFormLexicon c = unsafePerformIO $ do
ref <- newIORef []
(allocaBytes (#size PgfSequenceItor) $ \itor ->
bracket (wrapSequenceItorCallback (getSequences ref)) freeHaskellFunPtr $ \fptr ->
(allocaBytes (#size PgfSequenceItor) $ \itor1 ->
bracket (wrapSequenceItorCallback (getSequences ref)) freeHaskellFunPtr $ \fptr1 ->
allocaBytes (#size PgfMorphoCallback) $ \itor2 ->
bracket (wrapMorphoCallback (getMorphology ref)) freeHaskellFunPtr $ \fptr2 ->
withForeignPtr (c_revision c) $ \c_revision -> do
(#poke PgfSequenceItor, fn) itor fptr
seq_ids <- withPgfExn "fullFormLexicon" (pgf_iter_sequences (c_db c) c_revision itor)
(#poke PgfSequenceItor, fn) itor1 fptr1
(#poke PgfMorphoCallback, fn) itor2 fptr2
seq_ids <- withPgfExn "fullFormLexicon" (pgf_iter_sequences (c_db c) c_revision itor1 itor2)
pgf_release_phrasetable_ids seq_ids)
fmap reverse (readIORef ref)
where
getSequences ref itor seq_id val exn = do
getSequences ref _ seq_id val exn = do
bracket (pgf_sequence_get_text_internal val) free $ \c_text ->
if c_text == nullPtr
then return ()
else do lemma <- peekText c_text
modifyIORef ref $ (\lexicon -> (lemma, []) : lexicon)
then return 1
else do form <- peekText c_text
case form of
[] -> return 1
_ -> do modifyIORef ref $ (\lexicon -> (form, []) : lexicon)
return 0
getMorphology ref _ c_name c_field c_prob exn = do
name <- peekText c_name
field <- peekText c_field
let prob = realToFrac c_prob
ann = (name,field,prob)
modifyIORef ref (\((form,anns) : lexicon) -> (form,ann:anns) : lexicon)
-- | This data type encodes the different outcomes which you could get from the parser.

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

@@ -46,6 +46,7 @@ data PgfLinBuilderIface
data PgfLinearizationOutputIface
data PgfGraphvizOptions
data PgfSequenceItor
data PgfMorphoCallback
data PgfPhrasetableIds
type Wrapper a = a -> IO (FunPtr a)
@@ -112,11 +113,15 @@ foreign import ccall pgf_iter_lincats :: Ptr PgfDB -> Ptr Concr -> Ptr PgfItor -
foreign import ccall pgf_iter_lins :: Ptr PgfDB -> Ptr Concr -> Ptr PgfItor -> Ptr PgfExn -> IO ()
type SequenceItorCallback = Ptr PgfSequenceItor -> CSize -> Ptr () -> Ptr PgfExn -> IO ()
type SequenceItorCallback = Ptr PgfSequenceItor -> CSize -> Ptr () -> Ptr PgfExn -> IO CInt
foreign import ccall "wrapper" wrapSequenceItorCallback :: Wrapper SequenceItorCallback
foreign import ccall pgf_iter_sequences :: Ptr PgfDB -> Ptr Concr -> Ptr PgfSequenceItor -> Ptr PgfExn -> IO (Ptr PgfPhrasetableIds)
type MorphoCallback = Ptr PgfMorphoCallback -> Ptr PgfText -> Ptr PgfText -> (#type prob_t) -> Ptr PgfExn -> IO ()
foreign import ccall "wrapper" wrapMorphoCallback :: Wrapper MorphoCallback
foreign import ccall pgf_iter_sequences :: Ptr PgfDB -> Ptr Concr -> Ptr PgfSequenceItor -> Ptr PgfMorphoCallback -> Ptr PgfExn -> IO (Ptr PgfPhrasetableIds)
foreign import ccall pgf_get_lincat_counts_internal :: Ptr () -> Ptr CSize -> IO ()