diff options
Diffstat (limited to 'src/runtime/haskell-bind')
| -rw-r--r-- | src/runtime/haskell-bind/PGF2.hsc | 2 | ||||
| -rw-r--r-- | src/runtime/haskell-bind/PGF2/FFI.hs | 3 | ||||
| -rw-r--r-- | src/runtime/haskell-bind/SG.hsc | 32 | ||||
| -rw-r--r-- | src/runtime/haskell-bind/SG/FFI.hs | 6 |
4 files changed, 41 insertions, 2 deletions
diff --git a/src/runtime/haskell-bind/PGF2.hsc b/src/runtime/haskell-bind/PGF2.hsc index c7b24d680..e88dcc9ce 100644 --- a/src/runtime/haskell-bind/PGF2.hsc +++ b/src/runtime/haskell-bind/PGF2.hsc @@ -59,8 +59,6 @@ import Data.Function(on) -- the foreign pointer in case if the application still has a reference -- to Concr but has lost its reference to PGF. -data PGF = PGF {pgf :: Ptr PgfPGF, pgfMaster :: ForeignPtr GuPool} -data Concr = Concr {concr :: Ptr PgfConcr, concrMaster :: PGF} type AbsName = String -- ^ Name of abstract syntax type ConcName = String -- ^ Name of concrete syntax diff --git a/src/runtime/haskell-bind/PGF2/FFI.hs b/src/runtime/haskell-bind/PGF2/FFI.hs index c6fc2e2e2..ee26214c7 100644 --- a/src/runtime/haskell-bind/PGF2/FFI.hs +++ b/src/runtime/haskell-bind/PGF2/FFI.hs @@ -9,6 +9,9 @@ import Foreign.ForeignPtr import Control.Exception import GHC.Ptr +data PGF = PGF {pgf :: Ptr PgfPGF, pgfMaster :: ForeignPtr GuPool} +data Concr = Concr {concr :: Ptr PgfConcr, concrMaster :: PGF} + ------------------------------------------------------------------ -- libgu API diff --git a/src/runtime/haskell-bind/SG.hsc b/src/runtime/haskell-bind/SG.hsc index 3f7baa5fd..5ee02b8b2 100644 --- a/src/runtime/haskell-bind/SG.hsc +++ b/src/runtime/haskell-bind/SG.hsc @@ -8,6 +8,8 @@ module SG( SG, openSG, closeSG , beginTrans, commit, rollback, inTransaction , SgId , insertExpr, getExpr + , updateFtsIndex + , queryLinearization , readTriple, showTriple , insertTriple, getTriple , queryTriple @@ -106,6 +108,36 @@ getExpr (SG sg) id = do return Nothing else do return $ Just (Expr c_expr exprFPl) +updateFtsIndex :: SG -> PGF -> IO () +updateFtsIndex (SG sg) p = do + withGuPool $ \tmpPl -> do + exn <- gu_new_exn tmpPl + sg_update_fts_index sg (pgf p) exn + handle_sg_exn exn + +queryLinearization :: SG -> String -> IO [Expr] +queryLinearization (SG sg) query = do + exprPl <- gu_new_pool + exprFPl <- newForeignPtr gu_pool_finalizer exprPl + (withCString query $ \c_query -> + withGuPool $ \tmpPl -> do + exn <- gu_new_exn tmpPl + seq <- sg_query_linearization sg c_query tmpPl exn + handle_sg_exn exn + len <- (#peek GuSeq, len) seq + ids <- peekArray (fromIntegral (len :: CInt)) (seq `plusPtr` (#offset GuSeq, data)) + getExprs exprFPl exprPl exn ids) + where + getExprs exprFPl exprPl exn [] = return [] + getExprs exprFPl exprPl exn (id:ids) = do + c_expr <- sg_get_expr sg id exprPl exn + handle_sg_exn exn + if c_expr == nullPtr + then getExprs exprFPl exprPl exn ids + else do let e = Expr c_expr exprFPl + es <- getExprs exprFPl exprPl exn ids + return (e:es) + ----------------------------------------------------------------------- -- Triples diff --git a/src/runtime/haskell-bind/SG/FFI.hs b/src/runtime/haskell-bind/SG/FFI.hs index 37c7f8c3a..69e3efe3f 100644 --- a/src/runtime/haskell-bind/SG/FFI.hs +++ b/src/runtime/haskell-bind/SG/FFI.hs @@ -32,6 +32,12 @@ foreign import ccall "sg/sg.h sg_insert_expr" foreign import ccall "sg/sg.h sg_get_expr" sg_get_expr :: Ptr SgSG -> SgId -> Ptr GuPool -> Ptr GuExn -> IO PgfExpr +foreign import ccall "sg/sg.h sg_update_fts_index" + sg_update_fts_index :: Ptr SgSG -> Ptr PgfPGF -> Ptr GuExn -> IO () + +foreign import ccall "sg/sg.h sg_query_linearization" + sg_query_linearization :: Ptr SgSG -> CString -> Ptr GuPool -> Ptr GuExn -> IO (Ptr GuSeq) + foreign import ccall "sg/sg.h sg_insert_triple" sg_insert_triple :: Ptr SgSG -> SgTriple -> Ptr GuExn -> IO SgId |
