summaryrefslogtreecommitdiff
path: root/src/runtime/haskell-bind
diff options
context:
space:
mode:
Diffstat (limited to 'src/runtime/haskell-bind')
-rw-r--r--src/runtime/haskell-bind/CHANGELOG.md8
-rw-r--r--src/runtime/haskell-bind/PGF2.hsc36
-rw-r--r--src/runtime/haskell-bind/PGF2/FFI.hsc7
-rw-r--r--src/runtime/haskell-bind/pgf2.cabal2
-rw-r--r--src/runtime/haskell-bind/test.hs12
5 files changed, 55 insertions, 10 deletions
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"