diff options
Diffstat (limited to 'src/runtime')
| -rw-r--r-- | src/runtime/haskell-bind/PGF2.hsc | 23 | ||||
| -rw-r--r-- | src/runtime/haskell-bind/PGF2/FFI.hsc | 1 | ||||
| -rw-r--r-- | src/runtime/haskell-bind/test.hs | 25 |
3 files changed, 13 insertions, 36 deletions
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 |