diff options
Diffstat (limited to 'src/runtime/haskell-bind/SG.hsc')
| -rw-r--r-- | src/runtime/haskell-bind/SG.hsc | 30 |
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 -> |
