From 034197344b9cf91229419476c12e5cf26915d947 Mon Sep 17 00:00:00 2001 From: Tienson Qin Date: Tue, 22 Sep 2026 06:10:42 +0000 Subject: [PATCH] Resolve forward lookup refs in transactions, apply value predicates to entity ids --- impl/built_ins.ml | 12 +- impl/parser.ml | 9 +- impl/query_eval.ml | 10 +- impl/transact.ml | 66 +++++++-- test/test_query_engine_fixes.ml | 229 ++++++++++++++++++++++++++++++++ test/test_sqlite_storage.ml | 51 +++++++ 6 files changed, 360 insertions(+), 17 deletions(-) diff --git a/impl/built_ins.ml b/impl/built_ins.ml index ee84b5a..c3b52f6 100644 --- a/impl/built_ins.ml +++ b/impl/built_ins.ml @@ -45,9 +45,11 @@ let value_is_not_empty value = | None -> false let matches_value_predicate predicate value = + (* Ref values are entity ids — plain numbers upstream — so numeric + predicates and arithmetic see them as integers *) match predicate, value with - | NumberValue, (Int _ | Float _) -> true - | IntegerValue, Int _ -> true + | NumberValue, (Int _ | Float _ | Ref _) -> true + | IntegerValue, (Int _ | Ref _) -> true | StringValue, String _ -> true | BooleanValue, Bool _ -> true | KeywordValue, Keyword _ -> true @@ -56,13 +58,18 @@ let matches_value_predicate predicate value = let matches_numeric_predicate predicate value = match predicate, value with | ZeroNumber, Int value -> value = 0 + | ZeroNumber, Ref value -> value = 0 | ZeroNumber, Float value -> value = 0.0 | PositiveNumber, Int value -> value > 0 + | PositiveNumber, Ref value -> value > 0 | PositiveNumber, Float value -> value > 0.0 | NegativeNumber, Int value -> value < 0 + | NegativeNumber, Ref value -> value < 0 | NegativeNumber, Float value -> value < 0.0 | EvenInteger, Int value -> value mod 2 = 0 + | EvenInteger, Ref value -> value mod 2 = 0 | OddInteger, Int value -> value mod 2 <> 0 + | OddInteger, Ref value -> value mod 2 <> 0 | (EvenInteger | OddInteger), Float _ -> false | _, _ -> false @@ -90,6 +97,7 @@ let all_values_equal = function let numeric_value = function | Int value -> Some (`Int value) + | Ref value -> Some (`Int value) | Float value -> Some (`Float value) | _ -> None diff --git a/impl/parser.ml b/impl/parser.ml index da228b7..7f877b2 100644 --- a/impl/parser.ml +++ b/impl/parser.ml @@ -1230,7 +1230,14 @@ let parse_complement_predicate_clause context symbol args = | _ -> invalid_arg (one_arg_message symbol) in let unary_value_predicate predicate = - unary_result_predicate (function Result_value value -> predicate value | _ -> false) + (* Bound entity ids arrive as Result_entity but are plain numbers + upstream: convert through value_of_query_result so numeric/value + predicates (even?, integer?, number?, ...) apply to them *) + unary_result_predicate + (fun result -> + match context.value_of_query_result result with + | Some value -> predicate value + | None -> false) in let binary_string_predicate predicate = match args with diff --git a/impl/query_eval.ml b/impl/query_eval.ml index 7d089b4..b5ce0bf 100644 --- a/impl/query_eval.ml +++ b/impl/query_eval.ml @@ -156,9 +156,15 @@ let value_has_count = Built_ins.value_has_count let value_is_not_empty = Built_ins.value_is_not_empty let eval_value_predicate_clause context db bindings term predicate = + (* Bound entity ids arrive as Result_entity but are plain numbers + upstream: convert through value_of_query_result so value/numeric + predicates (number?, integer?, even?, ...) apply to them *) match eval_query_term (context.match_context db) bindings term with - | Some (Result_value value) when predicate value -> [ bindings ] - | Some _ | None -> [] + | Some result -> + (match value_of_query_result result with + | Some value when predicate value -> [ bindings ] + | Some _ | None -> []) + | None -> [] let matches_value_predicate = Built_ins.matches_value_predicate diff --git a/impl/transact.ml b/impl/transact.ml index 693bf04..916f1f5 100644 --- a/impl/transact.ml +++ b/impl/transact.ml @@ -45,6 +45,13 @@ let remember_current_tx_alias tempids tx alias = in insert_after_current_tx_aliases [] tempids +(* Raised when a lookup ref cannot be resolved yet: the target may be defined + by a later op in the same transaction. apply_ops defers such ops and retries + them as the tx datoms accumulate; if they still cannot resolve at tx end the + original "Nothing found" error is raised (matching upstream's strict + sequential behavior for genuinely missing targets). *) +exception Unresolved_lookup_ref of attr * value + let rec resolve_entity_ref context db datoms tx max_eid tempids = function | Entity_id e -> let e = context.validate_entity_id e in @@ -65,9 +72,9 @@ let rec resolve_entity_ref context db datoms tx max_eid tempids = function e, context.max_eid_with_entity_id max_eid e, remember_tempid tempids tempid e) | Lookup_ref (attr, value) -> let value, max_eid, tempids = resolve_value context db datoms tx max_eid tempids value in - (match context.lookup_ref_entity_id ~strict_missing:true datoms attr value with + (match context.lookup_ref_entity_id ~strict_missing:false datoms attr value with | Some e -> e, context.max_eid_with_entity_id max_eid e, tempids - | None -> invalid_arg (context.unresolved_lookup_ref_message attr value)) + | None -> raise (Unresolved_lookup_ref (attr, value))) and resolve_value context db datoms tx max_eid tempids = function | TxRef -> Ref tx, max_eid, remember_current_tx tempids tx @@ -420,6 +427,7 @@ let apply_tx context tx_ops db = in let initial_max_eid = List.fold_left max_explicit_tx_op db.max_eid tx_ops in let max_tx_seen = ref tx in + let deferred_ops = ref [] in let mark_entity_tempid entity_tempids = function | Temp_id tempid -> tempid :: entity_tempids | _ -> entity_tempids @@ -746,7 +754,7 @@ let apply_tx context tx_ops db = max_eid tempids tx_value) - with Invalid_argument _ -> None) + with Invalid_argument _ | Unresolved_lookup_ref _ -> None) with | Some (tx_value, max_eid, tempids) -> (attr, tx_value) :: probe_attrs, max_eid, tempids @@ -1160,7 +1168,7 @@ let apply_tx context tx_ops db = in (match context.existing_unique_entity db lookup_attr lookup_value with | Some entity_id -> Ref entity_id, context.resolve_context.max_eid_with_entity_id max_eid entity_id - | None -> invalid_arg (context.resolve_context.unresolved_lookup_ref_message lookup_attr lookup_value)) + | None -> raise (Unresolved_lookup_ref (lookup_attr, lookup_value))) | _ -> let value, max_eid, _ = resolve_value_for_attr context.resolve_context db attr db tx max_eid [] value @@ -1512,21 +1520,55 @@ let apply_tx context tx_ops db = and apply_ops state tx_ops = List.fold_left (fun state tx_op -> - let state = apply_op state tx_op in - let datoms, _, _, _, tx_data = state in - if tx_op_affects_schema tx_op then refresh_schema datoms (List.rev tx_data); - state) + try + let state = apply_op state tx_op in + let datoms, _, _, _, tx_data = state in + if tx_op_affects_schema tx_op then refresh_schema datoms (List.rev tx_data); + state + with Unresolved_lookup_ref (attr, value) -> + (* The lookup ref target may be defined by a later op in this tx: + queue the op and retry it once more datoms accumulate. *) + deferred_ops := (tx_op, attr, value) :: !deferred_ops; + state) state tx_ops in + let rec drain_deferred_ops state = + let pending = List.rev !deferred_ops in + match pending with + | [] -> state + | (_, first_attr, first_value) :: _ -> + deferred_ops := []; + let progressed = ref false in + let state = + List.fold_left + (fun state (tx_op, _, _) -> + try + let state = apply_op state tx_op in + let datoms, _, _, _, tx_data = state in + if tx_op_affects_schema tx_op then refresh_schema datoms (List.rev tx_data); + progressed := true; + state + with Unresolved_lookup_ref (attr', value') -> + deferred_ops := (tx_op, attr', value') :: !deferred_ops; + state) + state + pending + in + (* No progress means the remaining targets never resolve: raise the same + error upstream raises for a lookup ref that points nowhere. *) + if not !progressed then + invalid_arg (context.resolve_context.unresolved_lookup_ref_message first_attr first_value) + else + drain_deferred_ops state + in let datoms, max_eid, tempids, entity_tempids, tx_data, fast_tx_data = - match try_apply_bulk_explicit_entities () with + match (try try_apply_bulk_explicit_entities () with Unresolved_lookup_ref _ -> None) with | Some (datoms, max_eid, tempids, entity_tempids, tx_data) -> datoms, max_eid, tempids, entity_tempids, tx_data, Some tx_data | None -> - let datoms, max_eid, tempids, entity_tempids, tx_data = - apply_ops (db, initial_max_eid, [], [], []) tx_ops - in + let state = apply_ops (db, initial_max_eid, [], [], []) tx_ops in + let datoms, max_eid, tempids, entity_tempids, tx_data = drain_deferred_ops state in datoms, max_eid, tempids, entity_tempids, tx_data, None in let tx_data = diff --git a/test/test_query_engine_fixes.ml b/test/test_query_engine_fixes.ml index 112308b..a7e031a 100644 --- a/test/test_query_engine_fixes.ml +++ b/test/test_query_engine_fixes.ml @@ -86,6 +86,103 @@ let test_recursive_rule_swapped_args () = (q_string ~inputs:[ Arg_rules rules ] db "[:find ?e1 ?e2 :in $ % :where (follow ?e1 ?e2)]") +(* Logseq's own rules (deps/db/src/logseq/db/frontend/rules.cljc): the + recursive call binds its first arg to an intermediate via a ref-pattern + clause and keeps the head var in the second arg. *) +let test_logseq_parent_rule () = + let schema = + let base_attr = + { cardinality = One; unique = None; indexed = false; is_component = false + ; no_history = false; doc = None; value_type = None; tuple_attrs = None + ; tuple_types = None } + in + [ "block/parent", { base_attr with value_type = Some RefType } ] + in + let db = + empty_db ~schema () + |> db_with + [ Entity { db_id = Some (Entity_id 1); attrs = [] } + ; Entity { db_id = Some (Entity_id 2); attrs = [ "block/parent", One_value (Ref 1) ] } + ; Entity { db_id = Some (Entity_id 3); attrs = [ "block/parent", One_value (Ref 2) ] } + ; Entity { db_id = Some (Entity_id 4); attrs = [ "block/parent", One_value (Ref 3) ] } + ] + in + let rules = + rules_of_string + "[[(parent ?p ?c) [?c :block/parent ?p]] + [(parent ?p ?c) [?t :block/parent ?p] (parent ?t ?c)]]" + in + assert_rows + "(parent 1 ?c) returns descendants of block 1" + [ [ Result_entity 2 ]; [ Result_entity 3 ]; [ Result_entity 4 ] ] + (q_string ~inputs:[ Arg_rules rules ] db + "[:find ?c :in $ % :where (parent 1 ?c)]"); + assert_rows + "(parent ?p 4) returns ancestors of block 4" + [ [ Result_entity 1 ]; [ Result_entity 2 ]; [ Result_entity 3 ] ] + (q_string ~inputs:[ Arg_rules rules ] db + "[:find ?p :in $ % :where (parent ?p 4)]") + +(* Upstream "Mutually recursive rules" (test-rules): two rules recursing into + each other *) +let test_mutually_recursive_rules () = + let db = + init_db + [ datom ~e:0 ~a:"f1" ~v:(Ref 1) () + ; datom ~e:1 ~a:"f2" ~v:(Ref 2) () + ; datom ~e:2 ~a:"f1" ~v:(Ref 3) () + ; datom ~e:3 ~a:"f2" ~v:(Ref 4) () + ; datom ~e:4 ~a:"f1" ~v:(Ref 5) () + ; datom ~e:5 ~a:"f2" ~v:(Ref 6) () + ] + in + let rules = + rules_of_string + "[[(f1 ?e1 ?e2) [?e1 :f1 ?e2]] + [(f1 ?e1 ?e2) [?t :f1 ?e2] (f2 ?e1 ?t)] + [(f2 ?e1 ?e2) [?e1 :f2 ?e2]] + [(f2 ?e1 ?e2) [?t :f2 ?e2] (f1 ?e1 ?t)]]" + in + assert_rows + "mutually recursive rules walk alternating edge kinds" + [ [ Result_entity 0; Result_entity 1 ] + ; [ Result_entity 0; Result_entity 3 ] + ; [ Result_entity 0; Result_entity 5 ] + ; [ Result_entity 1; Result_entity 3 ] + ; [ Result_entity 1; Result_entity 5 ] + ; [ Result_entity 2; Result_entity 3 ] + ; [ Result_entity 2; Result_entity 5 ] + ; [ Result_entity 3; Result_entity 5 ] + ; [ Result_entity 4; Result_entity 5 ] + ] + (q_string ~inputs:[ Arg_rules rules ] db + "[:find ?e1 ?e2 :in $ % :where (f1 ?e1 ?e2)]") + +(* Upstream "Joining regular clauses with rule" (test-rules): a bound var + flows into a rule invocation and a predicate filters it *) +let test_rule_joined_with_clauses () = + let db = + init_db + [ datom ~e:5 ~a:"follow" ~v:(Ref 3) () + ; datom ~e:1 ~a:"follow" ~v:(Ref 2) () + ; datom ~e:2 ~a:"follow" ~v:(Ref 3) () + ; datom ~e:3 ~a:"follow" ~v:(Ref 4) () + ; datom ~e:4 ~a:"follow" ~v:(Ref 6) () + ; datom ~e:2 ~a:"follow" ~v:(Ref 4) () + ] + in + let rules = + rules_of_string "[[(rule ?a ?b) [?a :follow ?b]]]" + in + assert_rows + "rule invocation unifies with already-bound vars" + [ [ Result_entity 3; Result_entity 2 ] + ; [ Result_entity 6; Result_entity 4 ] + ; [ Result_entity 4; Result_entity 2 ] + ] + (q_string ~inputs:[ Arg_rules rules ] db + "[:find ?y ?x :in $ % :where [_ _ ?x] (rule ?x ?y) [(even? ?x)]]") + (* Bug 2: predicates over :in-bound scalars must see the bindings *) let test_predicate_over_in_scalar () = let db = @@ -163,6 +260,8 @@ let block_schema () = in [ "block/uuid", { base_attr with unique = Some Identity; indexed = true } ; "block/parent", { base_attr with value_type = Some RefType } + ; "block/refs", { base_attr with cardinality = Many; value_type = Some RefType } + ; "block/title", base_attr ] let lookup_ref attr value = List [ Keyword attr; value ] @@ -250,6 +349,129 @@ let test_entity_map_lookup_ref_unresolved_raises () = then failf "unexpected error message: %s" msg) +(* Forward lookup refs: an entity map may reference an entity defined by a + LATER op in the same transaction. Ops whose refs do not resolve yet are + deferred and retried as the tx datoms accumulate; a ref that never resolves + still raises the upstream "Nothing found for entity id" error. *) +let uuid_of_eid db e = + datoms db Eavt ~e ~a:"block/uuid" () + |> List.of_seq + |> (function [ d ] -> Some d.v | _ -> None) + +let test_entity_map_lookup_ref_later_tx_entity () = + let u1 = "11111111-1111-1111-1111-111111111111" in + let u2 = "22222222-2222-2222-2222-222222222222" in + let db = + empty_db ~schema:(block_schema ()) () + |> db_with + [ Entity + { db_id = None + ; attrs = + [ "block/uuid", One_value (Uuid u1) + ; "block/parent", One_value (lookup_ref "block/uuid" (Uuid u2)) + ] + } + ; Entity { db_id = None; attrs = [ "block/uuid", One_value (Uuid u2) ] } + ] + in + let parent_datoms = + datoms db Aevt ~a:"block/parent" () + |> List.of_seq + |> List.map (fun d -> d.e, d.v) + in + (match parent_datoms with + | [ (e_a, Ref e_b) ] -> + if uuid_of_eid db e_a <> Some (Uuid u1) || uuid_of_eid db e_b <> Some (Uuid u2) then + failf "forward lookup ref should link u1's entity to u2's entity" + | _ -> + failf "forward lookup ref should produce one parent datom, got %d" (List.length parent_datoms)) + +let test_entity_map_lookup_ref_later_tx_entity_many_values () = + (* logseq db-worker repro: :block/refs is a cardinality-many ref attr whose + list contains a lookup ref to an entity map appearing LATER in the tx *) + let u1 = "11111111-1111-1111-1111-111111111111" in + let u2 = "22222222-2222-2222-2222-222222222222" in + let db = + empty_db ~schema:(block_schema ()) () + |> db_with + [ Entity + { db_id = None + ; attrs = + [ "block/uuid", One_value (Uuid u1) + ; "block/title", One_value (String "Root Page") + ; "block/refs", Many_values [ lookup_ref "block/uuid" (Uuid u2) ] + ] + } + ; Entity + { db_id = None + ; attrs = + [ "block/uuid", One_value (Uuid u2) + ; "block/title", One_value (String "Leaf Page") + ] + } + ] + in + let refs_datoms = + datoms db Aevt ~a:"block/refs" () + |> List.of_seq + |> List.map (fun d -> d.e, d.v) + in + (match refs_datoms with + | [ (e_a, Ref e_b) ] -> + if uuid_of_eid db e_a <> Some (Uuid u1) || uuid_of_eid db e_b <> Some (Uuid u2) then + failf "forward lookup ref in multi-value attr should link u1's entity to u2's entity" + | _ -> + failf "forward lookup ref should produce one refs datom, got %d" (List.length refs_datoms)) + +let test_add_op_lookup_ref_later_tx_entity () = + let u1 = "11111111-1111-1111-1111-111111111111" in + let u2 = "22222222-2222-2222-2222-222222222222" in + let db = + empty_db ~schema:(block_schema ()) () + |> db_with + [ Add (Entity_id 1, "block/uuid", Uuid u1) + ; Add (Entity_id 1, "block/parent", lookup_ref "block/uuid" (Uuid u2)) + ; Entity { db_id = None; attrs = [ "block/uuid", One_value (Uuid u2) ] } + ] + in + let parent_datoms = + datoms db Aevt ~a:"block/parent" () + |> List.of_seq + |> List.map (fun d -> d.e, d.v) + in + (match parent_datoms with + | [ (e_a, Ref e_b) ] -> + if uuid_of_eid db e_a <> Some (Uuid u1) || uuid_of_eid db e_b <> Some (Uuid u2) then + failf "Add op forward lookup ref should link u1's entity to u2's entity" + | _ -> + failf "Add op forward lookup ref should produce one parent datom, got %d" (List.length parent_datoms)) + +let test_entity_map_lookup_ref_never_resolves_raises () = + (* Deferral is not permanent: a ref whose target is absent from the whole tx + raises the same error as before, after all ops ran *) + let u1 = "11111111-1111-1111-1111-111111111111" in + let u2 = "22222222-2222-2222-2222-222222222222" in + (try + ignore + (empty_db ~schema:(block_schema ()) () + |> db_with + [ Entity + { db_id = None + ; attrs = + [ "block/uuid", One_value (Uuid u1) + ; "block/parent", One_value (lookup_ref "block/uuid" (Uuid u2)) + ] + } + ; Entity { db_id = None; attrs = [ "block/uuid", One_value (Uuid u1) ] } + ]); + failf "lookup ref that never resolves should raise" + with + | Invalid_argument msg -> + if not + (String.starts_with ~prefix:"Nothing found for entity id" msg) + then + failf "unexpected error message: %s" msg) + (* Bug 6: EDN reader accepts ' and friends inside symbol/keyword bodies *) let test_edn_symbol_special_chars () = (match Parser.read_edn "{:user.property/foo*+!_'?<>=- nil}" with @@ -271,6 +493,9 @@ let () = [ "recursive_rules_direction", test_recursive_rules_direction ; "rule_branches_positional_binding", test_rule_branches_positional_binding ; "recursive_rule_swapped_args", test_recursive_rule_swapped_args + ; "logseq_parent_rule", test_logseq_parent_rule + ; "mutually_recursive_rules", test_mutually_recursive_rules + ; "rule_joined_with_clauses", test_rule_joined_with_clauses ; "predicate_over_in_scalar", test_predicate_over_in_scalar ; "collection_in_binding", test_collection_in_binding ; "comparison_predicates_over_in", test_comparison_predicates_over_in @@ -278,5 +503,9 @@ let () = ; "entity_map_lookup_ref_earlier_tx_entity", test_entity_map_lookup_ref_earlier_tx_entity ; "entity_map_lookup_ref_same_entity", test_entity_map_lookup_ref_same_entity ; "entity_map_lookup_ref_unresolved_raises", test_entity_map_lookup_ref_unresolved_raises + ; "entity_map_lookup_ref_later_tx_entity", test_entity_map_lookup_ref_later_tx_entity + ; "entity_map_lookup_ref_later_tx_entity_many_values", test_entity_map_lookup_ref_later_tx_entity_many_values + ; "add_op_lookup_ref_later_tx_entity", test_add_op_lookup_ref_later_tx_entity + ; "entity_map_lookup_ref_never_resolves_raises", test_entity_map_lookup_ref_never_resolves_raises ; "edn_symbol_special_chars", test_edn_symbol_special_chars ] diff --git a/test/test_sqlite_storage.ml b/test/test_sqlite_storage.ml index d87bff8..4624070 100644 --- a/test/test_sqlite_storage.ml +++ b/test/test_sqlite_storage.ml @@ -893,6 +893,56 @@ let test_sqlite_storage_backed_connections_query_and_transact_after_restore () = [ [ Result_value (String "Tupen") ] ] (q_string restored_again "[:find ?aka :where [1 :aka ?aka]]")) +(* Restore must rebuild the full avet index, including ref-attr values: a + reverse-attr (_attr) pattern resolves through avet (attr, value) -> e *) +let test_sqlite_storage_restored_reverse_ref_lookup () = + if not (sqlite3_available ()) then + prerr_endline "Skipping SQLite restored reverse-ref lookup test: sqlite3 is not available" + else + with_temp_db (fun db_path -> + let storage = Sqlite_storage.storage db_path in + let schema = [ "name", unique_identity; "friend", ref_attr; "parent", ref_attr ] in + let conn = create_conn ~schema ~storage () in + ignore + (transact_conn + conn + [ Add (Entity_id 1, "name", String "Ivan") + ; Add (Entity_id 2, "name", String "Petr") + ; Add (Entity_id 2, "friend", Ref 1) + ; Add (Entity_id 3, "name", String "Anna") + ; Add (Entity_id 3, "parent", Ref 1) + ]); + let restored = + match restore_conn storage with + | Some conn -> conn + | None -> failwith "SQLite storage should restore a connection for reverse-ref lookup" + in + let restored_db = conn_db restored in + (* avet lookup by ref value: datoms whose v is (Ref 1) *) + let friend_refs = + datoms restored_db Avet ~a:"friend" () + |> List.filter (fun d -> d.v = Ref 1) + in + if List.map (fun d -> d.e, d.a, d.v) friend_refs <> [ 2, "friend", Ref 1 ] then + failwith "SQLite restored avet should index ref-attr values"; + (* _attr pattern: who references entity 1 via :friend *) + assert_equal_query + "restored SQLite conn answers reverse-ref patterns" + [ [ Result_value (String "Petr") ] ] + (q_string + restored_db + "[:find ?name + :where [1 :_friend ?child] + [?child :name ?name]]"); + assert_equal_query + "restored SQLite conn answers reverse-ref patterns for parent" + [ [ Result_value (String "Anna") ] ] + (q_string + restored_db + "[:find ?name + :where [1 :_parent ?child] + [?child :name ?name]]")) + let test_sqlite_storage_backed_connections_filter_entity_rules_and_repeated_transacts () = if not (sqlite3_available ()) then prerr_endline "Skipping SQLite storage-backed filter/entity/rules test: sqlite3 is not available" @@ -2834,6 +2884,7 @@ let () = test_sqlite_storage_does_not_require_sqlite3_binary (); test_sqlite_storage_store_and_delete_are_separate (); test_sqlite_storage_backed_connections_query_and_transact_after_restore (); + test_sqlite_storage_restored_reverse_ref_lookup (); test_sqlite_storage_backed_connections_filter_entity_rules_and_repeated_transacts (); test_sqlite_storage_backed_connections_index_query_and_transact_parity (); test_sqlite_storage_backed_composite_values_after_restore ();