summaryrefslogtreecommitdiff
path: root/src/runtime
diff options
context:
space:
mode:
Diffstat (limited to 'src/runtime')
-rw-r--r--src/runtime/c/sg/sg.c391
-rw-r--r--src/runtime/c/sg/sg.h11
-rw-r--r--src/runtime/haskell-bind/SG.hsc93
-rw-r--r--src/runtime/haskell-bind/SG/FFI.hs21
4 files changed, 484 insertions, 32 deletions
diff --git a/src/runtime/c/sg/sg.c b/src/runtime/c/sg/sg.c
index 76bff8d57..b6c69d7b4 100644
--- a/src/runtime/c/sg/sg.c
+++ b/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)
{
diff --git a/src/runtime/c/sg/sg.h b/src/runtime/c/sg/sg.h
index a94c28cb7..32a89d096 100644
--- a/src/runtime/c/sg/sg.h
+++ b/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);
diff --git a/src/runtime/haskell-bind/SG.hsc b/src/runtime/haskell-bind/SG.hsc
index b6707f031..c7600841c 100644
--- a/src/runtime/haskell-bind/SG.hsc
+++ b/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
diff --git a/src/runtime/haskell-bind/SG/FFI.hs b/src/runtime/haskell-bind/SG/FFI.hs
index 69e3efe3f..a6dce9494 100644
--- a/src/runtime/haskell-bind/SG/FFI.hs
+++ b/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
generated by cgit v1.2.3 (git 2.39.1) at 2026-05-20 20:39:32 +0000