From 450368f9bbf2948365953ae35069b5039ba38a28 Mon Sep 17 00:00:00 2001 From: "John J. Camilleri" Date: Mon, 3 May 2021 13:19:08 +0200 Subject: First attempt at adding support for complete in PGF2 (gives segmentation faults) --- src/runtime/haskell-bind/PGF2/FFI.hsc | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) (limited to 'src/runtime/haskell-bind/PGF2') diff --git a/src/runtime/haskell-bind/PGF2/FFI.hsc b/src/runtime/haskell-bind/PGF2/FFI.hsc index c72c48e3b..04952f2d8 100644 --- a/src/runtime/haskell-bind/PGF2/FFI.hsc +++ b/src/runtime/haskell-bind/PGF2/FFI.hsc @@ -103,7 +103,7 @@ foreign import ccall unsafe "gu/file.h gu_file_in" 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" gu_string_buf_freeze :: Ptr GuStringBuf -> Ptr GuPool -> IO CString @@ -241,7 +241,7 @@ newSequence elem_size pokeElem values pool = do type FId = Int data PArg = PArg [FId] {-# UNPACK #-} !FId deriving (Eq,Ord,Show) -peekFId :: Ptr a -> IO FId +peekFId :: Ptr a -> IO FId peekFId c_ccat = do c_fid <- (#peek PgfCCat, fid) c_ccat return (fromIntegral (c_fid :: CInt)) @@ -422,6 +422,9 @@ foreign import ccall foreign import ccall "pgf/pgf.h pgf_parse_with_oracle" pgf_parse_with_oracle :: Ptr PgfConcr -> CString -> CString -> Ptr PgfOracleCallback -> Ptr GuExn -> Ptr GuPool -> Ptr GuPool -> IO (Ptr GuEnum) +foreign import ccall "pgf/pgf.h pgf_complete" + pgf_complete :: Ptr PgfConcr -> PgfType -> CString -> CString -> Ptr GuExn -> Ptr GuPool -> IO (Ptr GuEnum) + foreign import ccall "pgf/pgf.h pgf_lookup_morpho" pgf_lookup_morpho :: Ptr PgfConcr -> CString -> Ptr PgfMorphoCallback -> Ptr GuExn -> IO () -- cgit v1.2.3 From 84fd431afd54644bbe4bfc2c09c444f5a99e35cb Mon Sep 17 00:00:00 2001 From: "John J. Camilleri" Date: Mon, 3 May 2021 22:28:48 +0200 Subject: Manage to get completion working in PGF2 --- src/runtime/haskell-bind/PGF2.hsc | 23 ++++++++++++----------- src/runtime/haskell-bind/PGF2/FFI.hsc | 1 + src/runtime/haskell-bind/test.hs | 25 ------------------------- 3 files changed, 13 insertions(+), 36 deletions(-) delete mode 100644 src/runtime/haskell-bind/test.hs (limited to 'src/runtime/haskell-bind/PGF2') diff --git a/src/runtime/haskell-bind/PGF2.hsc b/src/runtime/haskell-bind/PGF2.hsc index b3b349ee1..38fae67ef 100644 --- a/src/runtime/haskell-bind/PGF2.hsc +++ b/src/runtime/haskell-bind/PGF2.hsc @@ -972,13 +972,13 @@ parseWithOracle lang cat sent (predict,complete,literal) = return ep Nothing -> do return nullPtr +-- | Returns possible completions of the current partial input. complete :: Concr -- ^ the language with which we parse - -> Type -- ^ the start category - -> String -- ^ the input sentence - -> String -- ^ prefix (?) - -> Maybe Int -- ^ maximum number of results - -> ParseOutput [String] -complete lang (Type ctype _) sent pfx mn = + -> Type -- ^ the start category + -> String -- ^ the input sentence (excluding token being completed) + -> String -- ^ prefix (partial token being completed) + -> ParseOutput [(String, CId, CId, Float)] -- ^ (token, category, function, probability) +complete lang (Type ctype _) sent pfx = unsafePerformIO $ do parsePl <- gu_new_pool exn <- gu_new_exn parsePl @@ -1013,7 +1013,7 @@ complete lang (Type ctype _) sent pfx mn = fpl <- newForeignPtr gu_pool_finalizer parsePl ParseOk <$> fromCompletions enum fpl where - fromCompletions :: Ptr GuEnum -> ForeignPtr GuPool -> IO [String] + fromCompletions :: Ptr GuEnum -> ForeignPtr GuPool -> IO [(String, CId, CId, Float)] fromCompletions enum fpl = withGuPool $ \tmpPl -> do cmpEntry <- alloca $ \ptr -> @@ -1026,11 +1026,12 @@ complete lang (Type ctype _) sent pfx mn = touchConcr lang return [] else do - (sb,out) <- newOut tmpPl - cstr <- gu_string_buf_freeze sb tmpPl - tok <- peekUtf8CString cstr + tok <- peekUtf8CString =<< (#peek PgfTokenProb, tok) cmpEntry + cat <- peekUtf8CString =<< (#peek PgfTokenProb, cat) cmpEntry + fun <- peekUtf8CString =<< (#peek PgfTokenProb, fun) cmpEntry + prob <- (#peek PgfTokenProb, prob) cmpEntry toks <- unsafeInterleaveIO (fromCompletions enum fpl) - return (tok : toks) + return ((tok, cat, fun, prob) : toks) -- | Returns True if there is a linearization defined for that function in that language hasLinearization :: Concr -> Fun -> Bool diff --git a/src/runtime/haskell-bind/PGF2/FFI.hsc b/src/runtime/haskell-bind/PGF2/FFI.hsc index 04952f2d8..16f9ad46d 100644 --- a/src/runtime/haskell-bind/PGF2/FFI.hsc +++ b/src/runtime/haskell-bind/PGF2/FFI.hsc @@ -256,6 +256,7 @@ data PgfApplication data PgfConcr type PgfExpr = Ptr () data PgfExprProb +data PgfTokenProb data PgfExprParser data PgfFullFormEntry data PgfMorphoCallback diff --git a/src/runtime/haskell-bind/test.hs b/src/runtime/haskell-bind/test.hs deleted file mode 100644 index 1c0c9fa87..000000000 --- a/src/runtime/haskell-bind/test.hs +++ /dev/null @@ -1,25 +0,0 @@ -import PGF2 -import qualified Data.Char as C -import qualified Data.List as L -import qualified Data.Map as M - -main :: IO () -main = do - pgf <- readPGF "/Users/john/repositories/GF/contrib/foods/Foods.pgf" - let - Just concr = M.lookup "FoodsEng" (languages pgf) - loop = do - putStr "> " - input <- getLine - let - (sent,pfx) = - if C.isSpace (last input) - then (input, "") - else let toks = words input in (unwords (init toks), last toks) - let pr = complete concr (startCat pgf) sent pfx Nothing - case pr of - ParseOk x -> print x - ParseFailed x s -> putStrLn $ "parse failed at " ++ show x ++ " " ++ s - ParseIncomplete -> putStrLn "input incomplete" - loop - loop -- cgit v1.2.3