From 450368f9bbf2948365953ae35069b5039ba38a28 Mon Sep 17 00:00:00 2001 From: "John J. Camilleri" Date: Mon, 3 May 2021 13:19:08 +0200 Subject: [PATCH] First attempt at adding support for complete in PGF2 (gives segmentation faults) --- src/runtime/haskell-bind/CHANGELOG.md | 8 ++++-- src/runtime/haskell-bind/PGF2.hsc | 36 +++++++++++++++++++++++---- src/runtime/haskell-bind/PGF2/FFI.hsc | 7 ++++-- src/runtime/haskell-bind/pgf2.cabal | 2 +- src/runtime/haskell-bind/test.hs | 12 +++++++++ 5 files changed, 55 insertions(+), 10 deletions(-) create mode 100644 src/runtime/haskell-bind/test.hs diff --git a/src/runtime/haskell-bind/CHANGELOG.md b/src/runtime/haskell-bind/CHANGELOG.md index aed2d9c4f..570c7fd73 100644 --- a/src/runtime/haskell-bind/CHANGELOG.md +++ b/src/runtime/haskell-bind/CHANGELOG.md @@ -1,7 +1,11 @@ +## 1.3.0 + +- Add completion support. + ## 1.2.1 -- Remove deprecated pgf_print_expr_tuple -- Added an API for cloning expressions/types/literals +- Remove deprecated `pgf_print_expr_tuple`. +- Added an API for cloning expressions/types/literals. ## 1.2.0 diff --git a/src/runtime/haskell-bind/PGF2.hsc b/src/runtime/haskell-bind/PGF2.hsc index 4204867f1..bd7cf2fe9 100644 --- a/src/runtime/haskell-bind/PGF2.hsc +++ b/src/runtime/haskell-bind/PGF2.hsc @@ -43,32 +43,28 @@ module PGF2 (-- * PGF mkCId, exprHash, exprSize, exprFunctions, exprSubstitute, treeProbability, - -- ** Types Type, Hypo, BindType(..), startCat, readType, showType, showContext, mkType, unType, - -- ** Type checking -- | Dynamically-built expressions should always be type-checked before using in other functions, -- as the exceptions thrown by using invalid expressions may not catchable. checkExpr, inferExpr, checkType, - -- ** Computing compute, -- * Concrete syntax ConcName,Concr,languages,concreteName,languageCode, - -- ** Linearization linearize,linearizeAll,tabularLinearize,tabularLinearizeAll,bracketedLinearize,bracketedLinearizeAll, FId, BracketedString(..), showBracketedString, flattenBracketedString, printName, categoryFields, - alignWords, -- ** Parsing ParseOutput(..), parse, parseWithHeuristics, parseToChart, PArg(..), + complete, -- ** Sentence Lookup lookupSentence, -- ** Generation @@ -976,6 +972,36 @@ parseWithOracle lang cat sent (predict,complete,literal) = return ep Nothing -> do return nullPtr +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 [(Expr,Float)] +complete lang (Type ctype _) sent pfx mn = + unsafePerformIO $ do + parsePl <- gu_new_pool + exprPl <- gu_new_pool + exn <- gu_new_exn parsePl + + sent <- newUtf8CString sent parsePl + pfx <- newUtf8CString pfx parsePl + + enum <- pgf_complete (concr lang) ctype sent pfx exn parsePl + failed <- gu_exn_is_raised exn + if failed + then do + is_parse_error <- gu_exn_caught exn gu_exn_type_PgfParseError + if is_parse_error + then return (ParseFailed 0 "") + else throwIO (PGFError "Some other error") + -- TODO cleanup!!! + else do + parseFPl <- newForeignPtr gu_pool_finalizer parsePl + exprFPl <- newForeignPtr gu_pool_finalizer exprPl + exprs <- fromPgfExprEnum enum parseFPl (touchConcr lang >> touchForeignPtr exprFPl) + return (ParseOk exprs) + -- | Returns True if there is a linearization defined for that function in that language hasLinearization :: Concr -> Fun -> Bool hasLinearization lang id = unsafePerformIO $ 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 () diff --git a/src/runtime/haskell-bind/pgf2.cabal b/src/runtime/haskell-bind/pgf2.cabal index 4ef9ed4f0..91e77c77b 100644 --- a/src/runtime/haskell-bind/pgf2.cabal +++ b/src/runtime/haskell-bind/pgf2.cabal @@ -1,5 +1,5 @@ name: pgf2 -version: 1.2.1 +version: 1.3.0 synopsis: Bindings to the C version of the PGF runtime description: GF, Grammatical Framework, is a programming language for multilingual grammar applications. diff --git a/src/runtime/haskell-bind/test.hs b/src/runtime/haskell-bind/test.hs new file mode 100644 index 000000000..16e7ff7cb --- /dev/null +++ b/src/runtime/haskell-bind/test.hs @@ -0,0 +1,12 @@ +import PGF2 +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) + let pr = complete concr (startCat pgf) "this" "wi" Nothing + case pr of + ParseOk x -> print (head x) + ParseFailed _ _ -> putStrLn "parse failed" + ParseIncomplete -> putStrLn "input incomplete"