First attempt at adding support for complete in PGF2 (gives segmentation faults)

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
 

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 $

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 ()
 

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.

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"