summaryrefslogtreecommitdiff
path: root/src/runtime/haskell-bind/SG.hsc
diff options
context:
space:
mode:
Diffstat (limited to 'src/runtime/haskell-bind/SG.hsc')
-rw-r--r--src/runtime/haskell-bind/SG.hsc30
1 files changed, 29 insertions, 1 deletions
diff --git a/src/runtime/haskell-bind/SG.hsc b/src/runtime/haskell-bind/SG.hsc
index 5ee02b8b2..b6707f031 100644
--- a/src/runtime/haskell-bind/SG.hsc
+++ b/src/runtime/haskell-bind/SG.hsc
@@ -11,6 +11,7 @@ module SG( SG, openSG, closeSG
, updateFtsIndex
, queryLinearization
, readTriple, showTriple
+ , readTriples
, insertTriple, getTriple
, queryTriple
) where
@@ -147,7 +148,7 @@ readTriple str =
do exprPl <- gu_new_pool
withGuPool $ \tmpPl ->
withCString str $ \c_str ->
- withTriple $ \triple -> do
+ withTriple $ \triple ->
do guin <- gu_string_in c_str tmpPl
exn <- gu_new_exn tmpPl
ok <- pgf_read_expr_tuple guin 3 triple exprPl exn
@@ -176,6 +177,33 @@ showTriple (Expr expr1 _) (Expr expr2 _) (Expr expr3 _) =
s <- gu_string_buf_freeze sb tmpPl
peekCString s
+readTriples :: String -> Maybe [(Expr,Expr,Expr)]
+readTriples str =
+ unsafePerformIO $
+ do exprPl <- gu_new_pool
+ withGuPool $ \tmpPl ->
+ withCString str $ \c_str ->
+ do guin <- gu_string_in c_str tmpPl
+ exn <- gu_new_exn tmpPl
+ seq <- pgf_read_expr_matrix guin 3 exprPl exn
+ status <- gu_exn_is_raised exn
+ if (seq /= nullPtr && not status)
+ then do exprFPl <- newForeignPtr gu_pool_finalizer exprPl
+ count <- (#peek GuSeq, len) seq
+ ts <- peekTriples exprFPl (fromIntegral (count :: CInt)) (seq `plusPtr` (#offset GuSeq, data))
+ return (Just ts)
+ else do gu_pool_free exprPl
+ return Nothing
+ where
+ peekTriples exprFPl count triple
+ | count == 0 = return []
+ | otherwise = do c_expr1 <- peekElemOff triple 0
+ c_expr2 <- peekElemOff triple 1
+ c_expr3 <- peekElemOff triple 2
+ let t = (Expr c_expr1 exprFPl,Expr c_expr2 exprFPl,Expr c_expr3 exprFPl)
+ ts <- peekTriples exprFPl (count-3) (triple `plusPtr` (3*sizeOf c_expr1))
+ return (t:ts)
+
insertTriple :: SG -> Expr -> Expr -> Expr -> IO SgId
insertTriple (SG sg) (Expr expr1 _) (Expr expr2 _) (Expr expr3 _) =
withGuPool $ \tmpPl ->