added a primitive full-text search index in libsg. This can be use for finding an abstract tree whose linearization matches given keywords

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