diff options
Diffstat (limited to 'src/runtime/haskell-bind')
| -rw-r--r-- | src/runtime/haskell-bind/PGF2.hsc | 32 | ||||
| -rw-r--r-- | src/runtime/haskell-bind/PGF2/FFI.hsc | 5 |
2 files changed, 35 insertions, 2 deletions
diff --git a/src/runtime/haskell-bind/PGF2.hsc b/src/runtime/haskell-bind/PGF2.hsc index 75afabb3d..5644b6ce8 100644 --- a/src/runtime/haskell-bind/PGF2.hsc +++ b/src/runtime/haskell-bind/PGF2.hsc @@ -70,7 +70,7 @@ module PGF2 (-- * PGF -- ** Generation generateAll, -- ** Morphological Analysis - MorphoAnalysis, lookupMorpho, fullFormLexicon, + MorphoAnalysis, lookupMorpho, lookupCohorts, fullFormLexicon, -- ** Visualizations GraphvizOptions(..), graphvizDefaults, graphvizAbstractTree, graphvizParseTree, graphvizWordAlignment, @@ -481,6 +481,36 @@ lookupMorpho (Concr concr master) sent = freeHaskellFunPtr fptr readIORef ref +lookupCohorts :: Concr -> String -> [(Int,[MorphoAnalysis],Int)] +lookupCohorts lang@(Concr concr master) sent = + unsafePerformIO $ + do pl <- gu_new_pool + ref <- newIORef [] + cback <- gu_malloc pl (#size PgfMorphoCallback) + fptr <- wrapLookupMorphoCallback (getAnalysis ref) + (#poke PgfMorphoCallback, callback) cback fptr + c_sent <- newUtf8CString sent pl + enum <- pgf_lookup_cohorts concr c_sent cback pl nullPtr + fpl <- newForeignPtr gu_pool_finalizer pl + fromCohortRange enum fpl fptr ref + where + fromCohortRange enum fpl fptr ref = + allocaBytes (#size PgfCohortRange) $ \ptr -> + withForeignPtr fpl $ \pl -> + do gu_enum_next enum ptr pl + buf <- (#peek PgfCohortRange, buf) ptr + if buf == nullPtr + then do finalizeForeignPtr fpl + freeHaskellFunPtr fptr + touchConcr lang + return [] + else do start <- (#peek PgfCohortRange, start.pos) ptr + end <- (#peek PgfCohortRange, end.pos) ptr + ans <- readIORef ref + writeIORef ref [] + cohs <- unsafeInterleaveIO (fromCohortRange enum fpl fptr ref) + return ((start,ans,end):cohs) + fullFormLexicon :: Concr -> [(String, [MorphoAnalysis])] fullFormLexicon lang = unsafePerformIO $ diff --git a/src/runtime/haskell-bind/PGF2/FFI.hsc b/src/runtime/haskell-bind/PGF2/FFI.hsc index 39b18fcf3..713adcecc 100644 --- a/src/runtime/haskell-bind/PGF2/FFI.hsc +++ b/src/runtime/haskell-bind/PGF2/FFI.hsc @@ -100,7 +100,7 @@ foreign import ccall unsafe "gu/string.h gu_string_buf_out" foreign import ccall unsafe "gu/file.h gu_file_in" gu_file_in :: Ptr () -> Ptr GuPool -> IO (Ptr GuIn) -foreign import ccall unsafe "gu/enum.h gu_enum_next" +foreign import ccall safe "gu/enum.h gu_enum_next" gu_enum_next :: Ptr a -> Ptr (Ptr b) -> Ptr GuPool -> IO () foreign import ccall unsafe "gu/string.h gu_string_buf_freeze" @@ -401,6 +401,9 @@ foreign import ccall "pgf/pgf.h pgf_parse_with_oracle" foreign import ccall "pgf/pgf.h pgf_lookup_morpho" pgf_lookup_morpho :: Ptr PgfConcr -> CString -> Ptr PgfMorphoCallback -> Ptr GuExn -> IO () +foreign import ccall "pgf/pgf.h pgf_lookup_cohorts" + pgf_lookup_cohorts :: Ptr PgfConcr -> CString -> Ptr PgfMorphoCallback -> Ptr GuPool -> Ptr GuExn -> IO (Ptr GuEnum) + type LookupMorphoCallback = Ptr PgfMorphoCallback -> CString -> CString -> Float -> Ptr GuExn -> IO () foreign import ccall "wrapper" |