a prototype for complex queries over expressions in libsg

src/runtime/c/sg/sg.c

@@ -2,6 +2,7 @@
 #include "sqlite3Btree.h"
 
 #include "sg/sg.h"
+#include "gu/mem.h"
 #include "pgf/data.h"
 
 #define SG_EXPRS       1
@@ -802,6 +803,396 @@ rollback:
 	return gu_null_variant;
 }
 
+// A query is compiled into a sequence of instructions with
+// the following codes:
+#define QI_PUSH   1
+#define QI_VAR    2
+#define QI_APPLY  3
+#define QI_RETURN 4
+
+typedef struct {
+	int  code;
+	SgId arg;
+} QueryInstr;
+
+struct SgQueryExprResult {
+	ExprContext ectxt;
+	GuBuf* instrs;
+	GuBuf* queue;
+	size_t iState;
+	PgfMetaId min_meta_id;
+	PgfMetaId max_meta_id;
+};
+
+typedef struct QueryArg QueryArg;
+struct QueryArg {
+	QueryArg* prev;
+	SgId arg;
+};
+
+typedef struct {
+	QueryArg* args;  // a stack of arguments
+	int pc;          // program counter
+} QueryState;
+
+static int
+build_expr_query(SgSG* sg,
+                 SgQueryExprResult* ctxt, PgfExpr expr)
+{
+	int rc = SQLITE_OK;
+
+	GuVariantInfo ei = gu_variant_open(expr);
+	switch (ei.tag) {
+	case PGF_EXPR_ABS: {
+		gu_impossible();
+		break;
+	}
+	case PGF_EXPR_APP: {
+		PgfExprApp* app = ei.data;
+
+		rc = build_expr_query(sg, ctxt, app->fun);
+		if (rc != SQLITE_OK)
+			return rc;
+		QueryInstr* first =
+			gu_buf_index_last(ctxt->instrs, QueryInstr);
+
+		rc = build_expr_query(sg, ctxt, app->arg);
+		if (rc != SQLITE_OK)
+			return rc;
+		QueryInstr* second =
+			gu_buf_index_last(ctxt->instrs, QueryInstr);
+
+		if (first->code == QI_PUSH && second->code == QI_PUSH &&
+		    second - first == 1) {
+			// we could directly combine the two expressions
+
+			Mem mem[2];
+			mem[0].flags = MEM_Int;
+			mem[0].u.i   = first->arg;
+			mem[1].flags = MEM_Int;
+			mem[1].u.i   = second->arg;
+
+			UnpackedRecord idxKey;
+			sqlite3BtreeInitUnpackedRecord(&idxKey, ctxt->ectxt.crsPairs, 2, 0, mem);
+
+			int res = 0;
+			rc = sqlite3BtreeMovetoUnpacked(ctxt->ectxt.crsPairs,
+											&idxKey, 0,  0, &res);
+			if (rc != SQLITE_OK)
+				return rc;
+			if (res != 0)
+				return SQLITE_DONE;
+
+			gu_buf_pop(ctxt->instrs, QueryInstr);
+
+			rc = sqlite3BtreeIdxRowid(sg->pBtree, ctxt->ectxt.crsPairs, &first->arg);
+   		} else if (gu_variant_tag(app->arg) != PGF_EXPR_META) {
+			QueryInstr* instr = gu_buf_extend(ctxt->instrs);
+			instr->code = QI_APPLY;
+			instr->arg  = 0;
+		}
+		break;
+	}
+	case PGF_EXPR_LIT: {
+		PgfExprLit* elit = ei.data;
+
+		Mem mem;
+
+		GuVariantInfo li = gu_variant_open(elit->lit);
+		switch (li.tag) {
+		case PGF_LITERAL_STR: {
+			PgfLiteralStr* lstr = li.data;
+
+			mem.flags = MEM_Str;
+			mem.n = strlen(lstr->val);
+			mem.z = lstr->val;
+			break;
+		}
+		case PGF_LITERAL_INT: {
+			PgfLiteralInt* lint = li.data;
+
+			mem.flags = MEM_Int;
+			mem.u.i = lint->val;
+			break;
+		}
+		case PGF_LITERAL_FLT: {
+			PgfLiteralFlt* lflt = li.data;
+
+			mem.flags = MEM_Real;
+			mem.u.r = lflt->val;
+			break;
+		}
+		default:
+			gu_impossible();
+		}
+
+		UnpackedRecord idxKey;
+		sqlite3BtreeInitUnpackedRecord(&idxKey, ctxt->ectxt.crsIdents, 1, 0, &mem);
+
+		int res = 0;
+		rc = sqlite3BtreeMovetoUnpacked(ctxt->ectxt.crsLiterals,
+		                                &idxKey, 0,  0, &res);
+		if (rc != SQLITE_OK)
+			return rc;
+		if (res != 0)
+			return SQLITE_DONE;
+
+		QueryInstr* instr = gu_buf_extend(ctxt->instrs);
+		instr->code = QI_PUSH;
+		rc = sqlite3BtreeIdxRowid(sg->pBtree, ctxt->ectxt.crsLiterals, &instr->arg);
+		break;
+	}
+	case PGF_EXPR_META: {
+		PgfExprMeta* emeta = ei.data;
+		QueryInstr* instr = gu_buf_extend(ctxt->instrs);
+		instr->code = QI_VAR;
+		instr->arg  = emeta->id;
+		
+		if (ctxt->min_meta_id > emeta->id)
+			ctxt->min_meta_id = emeta->id;
+		if (ctxt->max_meta_id < emeta->id)
+			ctxt->max_meta_id = emeta->id;
+		break;
+	}
+	case PGF_EXPR_FUN: {
+		PgfExprFun* fun = ei.data;
+
+		QueryInstr* instr = gu_buf_extend(ctxt->instrs);
+		instr->code = QI_PUSH;
+		rc = find_function_rowid(sg, &ctxt->ectxt, fun->fun, &instr->arg, 0);
+		if (rc == SQLITE_OK && instr->arg == 0)
+			return SQLITE_DONE;
+        break;
+	}
+	case PGF_EXPR_VAR: {
+		gu_impossible();
+		break;
+	}
+	case PGF_EXPR_TYPED: {
+		PgfExprTyped* etyped = ei.data;
+		rc = build_expr_query(sg, ctxt, etyped->expr);
+		break;
+	}
+	case PGF_EXPR_IMPL_ARG: {
+		PgfExprImplArg* eimpl = ei.data;
+		rc = build_expr_query(sg, ctxt, eimpl->expr);
+		break;
+	}
+	default:
+		gu_impossible();
+	}
+
+	return rc;
+}
+
+static int
+run_expr_query(SgSG* sg, SgQueryExprResult* ctxt, GuPool* pool)
+{
+	int rc;
+
+	while (ctxt->iState < gu_buf_length(ctxt->queue)) {
+		QueryState* state =
+			gu_buf_index(ctxt->queue, QueryState, ctxt->iState);
+		QueryInstr* instr =
+			gu_buf_index(ctxt->instrs, QueryInstr, state->pc);
+
+		switch (instr->code) {
+		case QI_PUSH: {
+			QueryArg* arg = gu_new(QueryArg, pool);
+			arg->arg  = instr->arg;
+			arg->prev = state->args;
+			state->args = arg;
+			break;
+		}
+		case QI_VAR: {
+			assert(state->args != NULL);
+
+			Mem mem;
+			mem.flags = MEM_Int;
+			mem.u.i   = state->args->arg;
+
+			UnpackedRecord idxKey;
+			sqlite3BtreeInitUnpackedRecord(&idxKey, ctxt->ectxt.crsPairs, 1, 1, &mem);
+
+			int res = 0;
+			rc = sqlite3BtreeMovetoUnpacked(ctxt->ectxt.crsPairs,
+											&idxKey, 0,  0, &res);
+			if (rc != SQLITE_OK)
+				return rc;
+			if (res < 0) {
+				rc = sqlite3BtreeNext(ctxt->ectxt.crsPairs, &res);
+			}
+			res = 0;
+
+			while (res == 0) {
+				i64 szData;
+				const unsigned char *zData;
+				rc = sqlite3BtreeKeySize(ctxt->ectxt.crsPairs, &szData);
+				if (rc != SQLITE_OK)
+					return rc;
+
+				u32 available = 0;
+				zData = sqlite3BtreeKeyFetch(ctxt->ectxt.crsPairs, &available);
+				if (szData > available)
+					gu_impossible();
+
+				idxKey.default_rc = 0;
+				res = sqlite3BtreeRecordCompare(available, zData, &idxKey);
+				if (res != 0)
+					break;
+
+				QueryArg* arg = gu_new(QueryArg, pool);
+				arg->prev = state->args->prev;
+
+				QueryState* state1 = gu_buf_extend(ctxt->queue);
+				state1->args = arg;
+				state1->pc   = state->pc+1;
+
+				rc = sqlite3BtreeIdxRowid(sg->pBtree, ctxt->ectxt.crsPairs, &arg->arg);
+				if (rc != SQLITE_OK)
+					return rc;
+
+				sqlite3BtreeNext(ctxt->ectxt.crsPairs, &res);
+				if (rc != SQLITE_OK)
+					return rc;
+			}
+
+			ctxt->iState++;
+			break;
+		}
+		case QI_APPLY: {
+			assert(state->args != NULL && state->args->prev);
+
+			Mem mem[2];
+			mem[0].flags = MEM_Int;
+			mem[0].u.i   = state->args->prev->arg;
+			mem[1].flags = MEM_Int;
+			mem[1].u.i   = state->args->arg;
+
+			UnpackedRecord idxKey;
+			sqlite3BtreeInitUnpackedRecord(&idxKey, ctxt->ectxt.crsPairs, 2, 0, mem);
+
+			int res = 0;
+			rc = sqlite3BtreeMovetoUnpacked(ctxt->ectxt.crsPairs,
+											&idxKey, 0,  0, &res);
+			if (rc != SQLITE_OK)
+				return rc;
+			if (res != 0) {
+				ctxt->iState++;
+				continue;
+			}
+
+			state->args = state->args->prev;
+
+			rc = sqlite3BtreeIdxRowid(sg->pBtree, ctxt->ectxt.crsPairs, &state->args->arg);
+			if (rc != SQLITE_OK)
+				return rc;
+			break;
+		}
+		case QI_RETURN:
+			return SQLITE_OK;
+		}
+
+		state->pc++;
+	}
+
+	return SQLITE_DONE;
+}
+
+SgQueryExprResult*
+sg_query_expr(SgSG *sg, PgfExpr expr, GuPool* pool, GuExn* err)
+{
+	int rc;
+
+	if (sg->autoCommit) {
+		rc = sqlite3BtreeBeginTrans(sg->pBtree, 0);
+		if (rc != SQLITE_OK) {
+			sg_raise_sqlite(rc, err);
+			return NULL;
+		}
+	}
+
+	SgQueryExprResult* ctxt = gu_new(SgQueryExprResult, pool);
+	rc = open_exprs(sg, 0, false, &ctxt->ectxt, err);
+	if (rc != SQLITE_OK)
+		goto close;
+
+	ctxt->instrs = gu_new_buf(QueryInstr, pool);
+	ctxt->queue  = gu_new_buf(QueryState, pool);
+	ctxt->iState = 0;
+	ctxt->min_meta_id = INT_MAX;
+	ctxt->max_meta_id = INT_MIN;
+
+	rc = build_expr_query(sg, ctxt, expr);
+	if (rc == SQLITE_OK) {
+		QueryInstr* instr = gu_buf_extend(ctxt->instrs);
+		instr->code = QI_RETURN;
+		instr->arg  = 0;
+
+		QueryState* state = gu_buf_extend(ctxt->queue);
+		state->args = NULL;
+		state->pc   = 0;
+	} else if (rc != SQLITE_DONE) {
+		sg_raise_sqlite(rc, err);
+		goto close;
+	}
+
+    return ctxt;
+
+close:
+	close_exprs(&ctxt->ectxt);
+
+	if (sg->autoCommit) {
+		sqlite3BtreeRollback(sg->pBtree, SQLITE_ABORT_ROLLBACK, 0);
+	}
+	return NULL;
+}
+
+PgfExpr
+sg_query_next(SgSG *sg, SgQueryExprResult* ctxt, SgId* pKey, GuPool* pool, GuExn* err)
+{
+	int rc;
+
+	rc = run_expr_query(sg, ctxt, pool);
+	if (rc == SQLITE_DONE)
+		return gu_null_variant;
+	if (rc != SQLITE_OK) {
+		sg_raise_sqlite(rc, err);
+		return gu_null_variant;
+	}
+
+	QueryState* state =
+		gu_buf_index(ctxt->queue, QueryState, ctxt->iState);
+	assert(state->args != NULL);
+	ctxt->iState++;
+
+	PgfExpr expr;
+	rc = load_expr(ctxt->ectxt.crsExprs, state->args->arg, &expr, pool);
+	if (rc != SQLITE_OK) {
+		sg_raise_sqlite(rc, err);
+		return gu_null_variant;
+	}
+
+	*pKey = state->args->arg;
+
+	return expr;
+}
+
+void
+sg_query_close(SgSG* sg, SgQueryExprResult* ctxt, GuExn* err)
+{
+	int rc;
+
+	close_exprs(&ctxt->ectxt);
+
+	if (sg->autoCommit) {
+		rc = sqlite3BtreeCommit(sg->pBtree);
+		if (rc != SQLITE_OK) {
+			sg_raise_sqlite(rc, err);
+		}
+	}
+}
+
 static int
 insert_token(SgSG *sg, BtCursor* crsTokens, GuString tok, SgId key)
 {

src/runtime/c/sg/sg.h

@@ -30,6 +30,17 @@ sg_insert_expr(SgSG *sg, PgfExpr expr, int wrFlag, GuExn* err);
 PgfExpr
 sg_get_expr(SgSG *sg, SgId key, GuPool* out_pool, GuExn* err);
 
+typedef struct SgQueryExprResult SgQueryExprResult;
+
+SgQueryExprResult*
+sg_query_expr(SgSG *sg, PgfExpr expr, GuPool* pool, GuExn* err);
+
+PgfExpr
+sg_query_next(SgSG *sg, SgQueryExprResult* ctxt, SgId* pKey, GuPool* pool, GuExn* err);
+
+void
+sg_query_close(SgSG* sg, SgQueryExprResult* ctxt, GuExn* err);
+
 void
 sg_update_fts_index(SgSG* sg, PgfPGF* pgf, GuExn* err);
 

src/runtime/haskell-bind/SG.hsc

@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveDataTypeable, ExistentialQuantification #-}
 
 #include <pgf/pgf.h>
 #include <gu/exn.h>
@@ -7,13 +7,13 @@
 module SG( SG, openSG, closeSG
          , beginTrans, commit, rollback, inTransaction
          , SgId
-         , insertExpr, getExpr
+         , insertExpr, getExpr, queryExpr
          , updateFtsIndex
          , queryLinearization
          , readTriple, showTriple
-         , readTriples
          , insertTriple, getTriple
          , queryTriple
+         , prepareQuery
          ) where
 
 import Foreign hiding (unsafePerformIO)
@@ -92,7 +92,7 @@ insertExpr :: SG -> Expr -> IO SgId
 insertExpr (SG sg) (Expr expr _) =
   withGuPool $ \tmpPl -> do
     exn <- gu_new_exn tmpPl
-    id <- sg_insert_expr sg expr exn
+    id <- sg_insert_expr sg expr 1 exn
     handle_sg_exn exn
     return id
 
@@ -109,6 +109,34 @@ getExpr (SG sg) id = do
               return Nothing
       else do return $ Just (Expr c_expr exprFPl)
 
+queryExpr :: SG -> Expr -> IO [(SgId,Expr)]
+queryExpr (SG sg) (Expr query _) =
+  withGuPool $ \tmpPl -> do
+    exn <- gu_new_exn tmpPl
+    res <- sg_query_expr sg query tmpPl exn
+    handle_sg_exn exn
+    fetchResults res exn
+  where
+    fetchResults res exn = do
+      exprPl <- gu_new_pool
+      (key,c_expr) <- alloca $ \pKey -> do
+                        c_expr <- sg_query_next sg res pKey exprPl exn
+                        key <- peek pKey
+                        return (key,c_expr)
+      failed <- gu_exn_is_raised exn
+      if failed
+        then do gu_pool_free exprPl
+                sg_query_close sg res exn
+                handle_sg_exn exn
+                return []
+        else if c_expr == nullPtr
+               then do gu_pool_free exprPl
+                       sg_query_close sg res exn
+                       return []
+               else do exprFPl <- newForeignPtr gu_pool_finalizer exprPl
+                       rest <- fetchResults res exn
+                       return ((key,Expr c_expr exprFPl) : rest)
+
 updateFtsIndex :: SG -> PGF -> IO ()
 updateFtsIndex (SG sg) p = do
   withGuPool $ \tmpPl -> do
@@ -177,33 +205,6 @@ 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 -> 
@@ -281,6 +282,36 @@ queryTriple (SG sg) mb_expr1 mb_expr2 mb_expr3 =
                                        ,fromCExpr c_expr2 exprFPl mb_expr2
                                        ,fromCExpr c_expr3 exprFPl mb_expr3) : rest)
 
+
+data Query = forall a . Query {query :: Ptr SgQuery, queryMaster :: a}
+
+prepareQuery :: SG -> String -> IO (Maybe Query)
+prepareQuery (SG sg) str =
+  withGuPool $ \tmpPl ->
+  withCString str $ \c_str ->
+    do guin <- gu_string_in c_str tmpPl
+       exn <- gu_new_exn tmpPl
+       queryPl <- gu_new_pool
+       q <- do seq <- pgf_read_expr_matrix guin 3 queryPl exn
+               if seq /= nullPtr
+                 then do count <- (#peek GuSeq, len) seq
+                         sg_prepare_query sg (count `div` 3) (seq `plusPtr` (#offset GuSeq, data)) queryPl exn
+                 else return nullPtr
+       failed <- gu_exn_is_raised exn
+       if failed
+         then do gu_pool_free queryPl
+                 is_sgerr <- gu_exn_caught exn gu_exn_type_SgError
+                 if is_sgerr
+                   then do c_msg <- (#peek GuExn, data.data) exn
+                           msg <- peekCString c_msg
+                           throwIO (SGError msg)
+                   else throwIO (SGError "Unknown database error")
+         else if q == nullPtr
+                then do gu_pool_free queryPl
+                        return Nothing
+                else do queryFPl <- newForeignPtr gu_pool_finalizer queryPl
+                        return (Just (Query q queryFPl))
+
 -----------------------------------------------------------------------
 -- Exceptions
 

src/runtime/haskell-bind/SG/FFI.hs

@@ -8,7 +8,10 @@ import GHC.Ptr
 import Data.Int
 
 data SgSG
+data SgQueryExprResult
 data SgTripleResult
+data SgQuery
+data SgQueryResult
 type SgId = Int64
 
 foreign import ccall "sg/sg.h sg_open"
@@ -27,11 +30,20 @@ foreign import ccall "sg/sg.h sg_rollback"
   sg_rollback :: Ptr SgSG -> Ptr GuExn -> IO ()
 
 foreign import ccall "sg/sg.h sg_insert_expr"
-  sg_insert_expr :: Ptr SgSG -> PgfExpr -> Ptr GuExn -> IO SgId
+  sg_insert_expr :: Ptr SgSG -> PgfExpr -> CInt -> Ptr GuExn -> IO SgId
 
 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_query_expr"
+  sg_query_expr :: Ptr SgSG -> PgfExpr -> Ptr GuPool -> Ptr GuExn -> IO (Ptr SgQueryExprResult)
+
+foreign import ccall "sg/sg.h sg_query_next"
+  sg_query_next :: Ptr SgSG -> Ptr SgQueryExprResult -> Ptr SgId -> Ptr GuPool -> Ptr GuExn -> IO PgfExpr
+
+foreign import ccall "sg/sg.h sg_query_close"
+  sg_query_close :: Ptr SgSG -> Ptr SgQueryExprResult -> Ptr GuExn -> IO ()
+
 foreign import ccall "sg/sg.h sg_update_fts_index"
   sg_update_fts_index :: Ptr SgSG -> Ptr PgfPGF -> Ptr GuExn -> IO ()
 
@@ -53,6 +65,13 @@ foreign import ccall "sg/sg.h sg_triple_result_fetch"
 foreign import ccall "sg/sg.h sg_triple_result_close"
   sg_triple_result_close :: Ptr SgTripleResult -> Ptr GuExn -> IO ()
 
+foreign import ccall "sg/sg.h sg_prepare_query"
+  sg_prepare_query :: Ptr SgSG -> CInt -> Ptr PgfExpr -> Ptr GuPool -> Ptr GuExn -> IO (Ptr SgQuery)
+
+foreign import ccall "sg/sg.h sg_query"
+  sg_query :: Ptr SgSG -> Ptr SgQuery -> Ptr GuExn -> IO (Ptr SgQueryResult)
+
+
 
 type SgTriple = Ptr PgfExpr