diff options
| author | Marcos Magueta <maguetamarcos@gmail.com> | 2026-06-22 22:55:27 -0300 |
|---|---|---|
| committer | GitHub <noreply@github.com> | 2026-06-22 22:55:27 -0300 |
| commit | b81586ee4a0543a5f9866586c78dccdd6328934a (patch) | |
| tree | 4cd2f26e8e57e7e8d852fb7deddd0818c482dc8b | |
| parent | 57b55b51ee6a1d4678ba37e4631d61a248411ff2 (diff) | |
| download | Sakura-b81586ee4a0543a5f9866586c78dccdd6328934a.tar.gz Sakura-b81586ee4a0543a5f9866586c78dccdd6328934a.zip | |
RNT ephemeral relations representation
Diffstat (limited to '')
| -rw-r--r-- | .github/workflows/ci.yml | 50 | ||||
| -rw-r--r-- | flake.lock | 14 | ||||
| -rw-r--r-- | flake.nix | 2 | ||||
| -rw-r--r-- | lib/dml/ast.ml | 8 | ||||
| -rw-r--r-- | lib/dml/executor.ml | 87 | ||||
| -rw-r--r-- | lib/drl/executor.ml | 28 | ||||
| -rw-r--r-- | lib/nt.ml | 143 | ||||
| -rw-r--r-- | lib/nt_ffi.ml | 107 | ||||
| -rw-r--r-- | lib/sublanguage_context.ml | 11 |
9 files changed, 370 insertions, 80 deletions
diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml new file mode 100644 index 0000000..037dd01 --- /dev/null +++ b/.github/workflows/ci.yml @@ -0,0 +1,50 @@ +name: CI + +on: + push: + branches: [master] + pull_request: + +concurrency: + group: ${{ github.workflow }}-${{ github.ref }} + cancel-in-progress: true + +jobs: + build: + name: Build + runs-on: ubuntu-latest + steps: + - uses: actions/checkout@v4 + - uses: DeterminateSystems/nix-installer-action@main + with: + extra-conf: | + access-tokens = github.com=${{ secrets.GITHUB_TOKEN }} + - uses: DeterminateSystems/magic-nix-cache-action@main + - name: Build the package + run: nix build .#relational_engine -L + + test: + name: Test + runs-on: ubuntu-latest + steps: + - uses: actions/checkout@v4 + - uses: DeterminateSystems/nix-installer-action@main + with: + extra-conf: | + access-tokens = github.com=${{ secrets.GITHUB_TOKEN }} + - uses: DeterminateSystems/magic-nix-cache-action@main + - name: Run the test suite + run: nix build .#checks.x86_64-linux.relational_engine -L + + format: + name: OCaml formatting + runs-on: ubuntu-latest + steps: + - uses: actions/checkout@v4 + - uses: DeterminateSystems/nix-installer-action@main + with: + extra-conf: | + access-tokens = github.com=${{ secrets.GITHUB_TOKEN }} + - uses: DeterminateSystems/magic-nix-cache-action@main + - name: Check dune/ocamlformat formatting + run: nix build .#checks.x86_64-linux.dune-fmt -L @@ -8,16 +8,16 @@ "picosha2": "picosha2" }, "locked": { - "lastModified": 1780706444, - "narHash": "sha256-POVEukSjJOs/oud/HiQZEOR5M6ZMlrhsXIteKAS2bCw=", + "lastModified": 1782176334, + "narHash": "sha256-BM1qUVA2cNsFlNdsY+SfkergvCSmGikFl6jRXLhFl6Y=", "owner": "mmagueta", "repo": "RNT", - "rev": "5174fc25698cff33b03b5746bf1742e417988f7d", + "rev": "663586b8d07c979218ceff79576bb549ee1973c5", "type": "github" }, "original": { "owner": "mmagueta", - "ref": "5174fc2", + "ref": "663586b", "repo": "RNT", "type": "github" } @@ -57,11 +57,11 @@ }, "nixpkgs": { "locked": { - "lastModified": 1778869304, - "narHash": "sha256-30sZNZoA1cqF5JNO9fVX+wgiQYjB7HJqqJ4ztCDeBZE=", + "lastModified": 1781577229, + "narHash": "sha256-lrp67w8AulE9Ks53n27I45ADSzbOCn4H+CNW1Ck8B+8=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "d233902339c02a9c334e7e593de68855ad26c4cb", + "rev": "567a49d1913ce81ac6e9582e3553dd90a955875f", "type": "github" }, "original": { @@ -8,7 +8,7 @@ type = "github"; owner = "mmagueta"; repo = "RNT"; - ref = "5174fc2"; + ref = "663586b"; inputs.nixpkgs.follows = "nixpkgs"; }; }; diff --git a/lib/dml/ast.ml b/lib/dml/ast.ml index d8defe6..03e68ac 100644 --- a/lib/dml/ast.ml +++ b/lib/dml/ast.ml @@ -9,4 +9,12 @@ type statement = | Assign of { target : string; body : Drl.Ast.query } | InsertFrom of { target : string; source : Drl.Ast.query } | DeleteWhere of { target : string; predicate : Drl.Ast.query } + (** Binds an unqualified name to a session-scoped ephemeral relation. + The body is recomputed on each scan and never materialized; + the binding lives until [DropDefine] or a session close. + In contrast, [Assign] drains the body into an existing + stored relation. *) + | Define of { target : string; body : Drl.Ast.query } + (** Drops a [Define] binding, releasing its session-ownership pin. *) + | DropDefine of { target : string } [@@deriving sexp] diff --git a/lib/dml/executor.ml b/lib/dml/executor.ml index c35f128..d5c55f8 100644 --- a/lib/dml/executor.ml +++ b/lib/dml/executor.ml @@ -43,7 +43,7 @@ module Make (NT : Nt.S) = struct (* Drain all tuples from a DRL query using ctx.resolve for path resolution. Cross-multigroup reads work transparently here. *) let drain_query (ctx : Sublanguage_context.t) query = - let* plan = DrlExec.compile ctx.resolve query in + let* plan = DrlExec.compile ctx query in let* stream = NT.execute_query plan ~rel_name:"dml_drain" in @@ -57,6 +57,58 @@ module Make (NT : Nt.S) = struct ignore (NT.stream_close stream); Ok tuples + (* Stored-relation paths referenced by a query, for ephemeral dependency + pinning. A qualified leaf resolves through ctx; an unqualified one is a + previously Defined session ephemeral (views compose). *) + let rec base_dep_paths (ctx : Sublanguage_context.t) (q : Drl.Ast.query) : + string list = + match q with + | Drl.Ast.Base name -> + (match Qualified_name.try_parse name with + | Ok fqn -> [ ctx.resolve fqn ] + | Error _ -> [ Sublanguage_context.ephemeral_path ctx name ]) + | Drl.Ast.Const _ -> [] + | Drl.Ast.Select (a, b) + | Drl.Ast.Join (_, a, b) + | Drl.Ast.Cartesian (a, b) + | Drl.Ast.Union (a, b) + | Drl.Ast.Diff (a, b) -> base_dep_paths ctx a @ base_dep_paths ctx b + | Drl.Ast.Project (_, s) + | Drl.Ast.Rename (_, s) + | Drl.Ast.Take (_, s) -> base_dep_paths ctx s + + (* Schema of a query result, walked structurally from the base relations' + schemas. Mirrors the operator semantics in docs/relational-algebra.org. *) + let rec infer_schema (ctx : Sublanguage_context.t) (q : Drl.Ast.query) : + (Schema.t, Condition.t) result = + match q with + | Drl.Ast.Base name -> + (match Qualified_name.try_parse name with + | Error _ -> + (* Session ephemeral: RNT owns its schema; nothing to derive + on the OCaml-side, so treated as contributing no attributes. *) + Ok [] + | Ok fqn -> + let* rel = get_rel ctx fqn in + Ok rel#schema) + | Drl.Ast.Const attrs -> Ok (List.map (fun (n, _) -> (n, "abstract")) attrs) + | Drl.Ast.Select (_, src) -> infer_schema ctx src + | Drl.Ast.Join (_, l, r) | Drl.Ast.Cartesian (l, r) -> + let* ls = infer_schema ctx l in + let* rs = infer_schema ctx r in + Ok (ls @ List.filter (fun (n, _) -> not (List.mem_assoc n ls)) rs) + | Drl.Ast.Project (attrs, src) -> + let* s = infer_schema ctx src in + Ok (List.filter (fun (n, _) -> List.mem n attrs) s) + | Drl.Ast.Rename (renames, src) -> + let* s = infer_schema ctx src in + Ok (List.map (fun (n, d) -> + match List.assoc_opt n renames with + | Some n' -> (n', d) + | None -> (n, d)) s) + | Drl.Ast.Union (l, _) | Drl.Ast.Diff (l, _) -> infer_schema ctx l + | Drl.Ast.Take (_, src) -> infer_schema ctx src + let attr_val_eq a b = Stdlib.( = ) a.Attribute.value b.Attribute.value @@ -136,6 +188,39 @@ module Make (NT : Nt.S) = struct (List.map (retarget rel#name) tuples) in after fqn + | Ast.Define { target; body } -> + let* () = + if String.contains target ':' then + Error (Error.parse_error + ("Define target must be unqualified (session-scoped): " ^ target)) + else Ok () + in + (* TODO: redefining an existing name isn't guarded. Right now we lean on + Hashtbl.replace and whatever RNT does on collision. Pick replace or + error and enforce it here. *) + let* schema = infer_schema ctx body in + (* TODO: every page drains the whole query and then filters down to the + window, so paging costs O(total * pages) and reruns the VM plan each + time. Push the offset/limit down or cache the result. *) + let generator ~offset ~limit = + match drain_query ctx body with + | Error _ -> [] + | Ok tuples -> + List.filteri (fun i _ -> i >= offset && i < offset + limit) tuples + in + let* _path = + NT.register_ephemeral ~session:ctx.session_hash ~named:true + ~name:target ~generator + ~cardinality:Conventions.Cardinality.ConstrainedFinite + ~identity:(Drl.Parser.to_string body) ~schema + ~deps:(base_dep_paths ctx body) + in + Ok [] + | Ast.DropDefine { target } -> + let* () = + NT.drop_ephemeral ~session:ctx.session_hash ~name:target + in + Ok [] | Ast.DeleteWhere { target; predicate } -> let* fqn = parse_fqn target in let* rel = get_rel ctx fqn in diff --git a/lib/drl/executor.ml b/lib/drl/executor.ml index 5f820c8..fffea19 100644 --- a/lib/drl/executor.ml +++ b/lib/drl/executor.ml @@ -10,34 +10,42 @@ module Make (NT : Nt.S) = struct let ( let* ) = Result.bind (* Compile a DRL AST query to a Tarski VM plan node tree. - Every base relation reference must be fully qualified ([<mg>:<rel>]); - [resolve] maps an FQN to its absolute RNT path. *) + A qualified base reference ([<mg>:<rel>]) resolves through [ctx.resolve] + to its stored-relation path; an unqualified name resolves to the + session-scoped ephemeral binding created by DML [Define]. *) let rec compile - (resolve : ?branch:string -> Qualified_name.t -> string) + (ctx : Sublanguage_context.t) (q : Ast.query) : (Nt.plan_node, Condition.t) result = match q with | Ast.Base name -> - let* fqn = Qualified_name.try_parse name in - Ok (Nt.Scan { path = resolve fqn; args = [] }) + (match Qualified_name.try_parse name with + | Error _ -> + Ok (Nt.Scan + { path = Sublanguage_context.ephemeral_path ctx name; + args = [] }) + | Ok fqn -> Ok (Nt.Scan { path = ctx.resolve fqn; args = [] })) | Ast.Join (on_attrs, q1, q2) -> - let* p1 = compile resolve q1 in - let* p2 = compile resolve q2 in + let* p1 = compile ctx q1 in + let* p2 = compile ctx q2 in Ok (Nt.Join { left = p1; right = p2; on_attrs }) | Ast.Take (n, q) -> - let* p = compile resolve q in + let* p = compile ctx q in Ok (Nt.Take { limit = n; source = p }) + | Ast.Project (attrs, q) -> + let* p = compile ctx q in + Ok (Nt.Project { attrs; source = p }) | Ast.Const _ -> Error (Error.unsupported_operator "Const: literal relations not yet reachable by VM; use Base") | _ -> Error (Error.unsupported_operator - "Select/Project/Rename/Union/Diff/Cartesian require VM operators not yet implemented") + "Select/Rename/Union/Diff/Cartesian require VM operators not yet implemented") let page_limit = 16 let execute (ctx : Sublanguage_context.t) (q : Ast.query) : (Sublanguage_types.result, Condition.t) result = - let* plan = compile ctx.resolve q in + let* plan = compile ctx q in let rel_name = "query_result" in let* stream = NT.execute_query plan ~rel_name in @@ -33,6 +33,7 @@ type plan_node = concrete join algorithm (e.g. HashJoin, NestedLoop, LeapFrog, &c) *) | Join of { left : plan_node; right : plan_node; on_attrs : string list } | Take of { limit : int; source : plan_node } + | Project of { attrs : string list; source : plan_node } module Error = struct open Condition @@ -295,12 +296,25 @@ module Make (B : Backend) = struct Query execution via the Tarski VM plan builder -------------------------------------------------------------------------- *) - (* Recursively builds a C-side PlanWrapper from an OCaml plan_node tree. - On partial failure the partially-built plan is freed before returning Error. *) + (* Recursively builds a C side plan tree via rnt_plan_assemble. + On partial failure the partially built plan is freed before returning + Error (assemble itself frees child plans it took ownership of when it + fails, hopefully). *) + let make_action (op : int) : Nt_ffi.plan_action structure = + let act = Ctypes.make Nt_ffi.plan_action in + setf act Nt_ffi.action_operation op; + act + let rec build_plan (plan : plan_node) : (nativeint, Condition.t) result = match plan with | Scan { path; _ } -> - let raw = Nt_ffi.rnt_plan_scan path in + let act = make_action Nt_ffi.fol_operation_scan in + let cpath = Nt_ffi.cstring path in + let scan = getf act Nt_ffi.action_scan in + setf scan Nt_ffi.scan_relation_path (Ctypes.CArray.start cpath); + let raw = Nt_ffi.rnt_plan_assemble act in + (* keep the C string alive across the call above *) + ignore (Sys.opaque_identity cpath); (match Nt_ffi.ptr_to_opt raw with | None -> Error (Error.cursor_error ("plan_scan failed for path: " ^ path)) | Some p -> Ok p) @@ -311,21 +325,43 @@ module Make (B : Backend) = struct Nt_ffi.rnt_plan_free (Nt_ffi.nint_to_ptr lp); Error e | Ok rp -> - let raw = Nt_ffi.rnt_plan_join - (Nt_ffi.nint_to_ptr lp) (Nt_ffi.nint_to_ptr rp) in - (* join takes ownership of both children — no manual free needed *) - (match Nt_ffi.ptr_to_opt raw with + let act = make_action Nt_ffi.fol_operation_join in + let join = getf act Nt_ffi.action_join in + setf join Nt_ffi.join_left (Nt_ffi.nint_to_ptr lp); + setf join Nt_ffi.join_right (Nt_ffi.nint_to_ptr rp); + (* assemble takes ownership of both children *) + (match Nt_ffi.ptr_to_opt (Nt_ffi.rnt_plan_assemble act) with | None -> Error (Error.cursor_error "plan_join failed") | Some p -> Ok p)) | Take { limit; source } -> let* sp = build_plan source in - let raw = Nt_ffi.rnt_plan_take - (Nt_ffi.nint_to_ptr sp) - (Unsigned.Size_t.of_int limit) in - (* take takes ownership of source — no manual free needed *) - (match Nt_ffi.ptr_to_opt raw with + let act = make_action Nt_ffi.fol_operation_take in + let take = getf act Nt_ffi.action_take in + setf take Nt_ffi.take_source (Nt_ffi.nint_to_ptr sp); + setf take Nt_ffi.take_limit (Unsigned.Size_t.of_int limit); + (* assemble takes ownership of source *) + (match Nt_ffi.ptr_to_opt (Nt_ffi.rnt_plan_assemble act) with | None -> Error (Error.cursor_error "plan_take failed") | Some p -> Ok p) + | Project { attrs; source } -> + let* sp = build_plan source in + let act = make_action Nt_ffi.fol_operation_project in + let proj = getf act Nt_ffi.action_project in + setf proj Nt_ffi.project_source (Nt_ffi.nint_to_ptr sp); + (* NULL-terminated const char**; backing arrays stay reachable until + assemble returns *) + let cattrs = List.map Nt_ffi.cstring attrs in + let arr = + Ctypes.CArray.of_list (Ctypes.ptr Ctypes.char) + (List.map Ctypes.CArray.start cattrs + @ [ Nt_ffi.null_char_ptr ]) + in + setf proj Nt_ffi.project_attrs (Ctypes.CArray.start arr); + let raw = Nt_ffi.rnt_plan_assemble act in + ignore (Sys.opaque_identity (cattrs, arr)); + (match Nt_ffi.ptr_to_opt raw with + | None -> Error (Error.cursor_error "plan_project failed") + | Some p -> Ok p) let execute_query (plan : plan_node) ~(rel_name : string) : (tuple_stream, Condition.t) result = @@ -385,6 +421,82 @@ module Make (B : Backend) = struct tuple.Tuple.attributes [] (* -------------------------------------------------------------------------- + Ephemeral relations + + RNT invokes a registered generator through a C function pointer for as + long as the registry entry is aive. ctypes does not root the closure, so + it is retained here keyed by registered path; reregistration replaces + the previous retention. (A dropped view's closure is released on the + next replacement, leaking one closure per named view until then is an + accepted cost of this slice) + -------------------------------------------------------------------------- *) + + let retained_generators + : (string, + unit Ctypes.ptr -> string -> Unsigned.size_t -> Unsigned.size_t -> + unit Ctypes.ptr -> int) + Hashtbl.t = + Hashtbl.create 16 + + let register_ephemeral ~(session : string) ~(named : bool) ~(name : string) + ~(generator : offset:int -> limit:int -> Tuple.materialized list) + ~(cardinality : Conventions.Cardinality.t) ~(identity : string) + ~(schema : Schema.t) ~(deps : string list) : (string, Condition.t) result = + (* The callback re-enters the RNT API (the generator typically executes a + VM plan over the base relations); the runtime is single threaded, so + this is safe. Exceptions must not cross the FFI boundary! *) + let cb _ctx _args offset limit sink = + try + let tuples = + generator + ~offset:(Unsigned.Size_t.to_int offset) + ~limit:(Unsigned.Size_t.to_int limit) + in + List.iter + (fun t -> + let kv = + materialized_to_kv t + |> List.map (fun (k, v) -> k ^ "=" ^ v) + |> String.concat "\n" + in + ignore (Nt_ffi.rnt_sink_emit sink (kv ^ "\n"))) + tuples; + 0 + with _ -> -1 + in + let schema_kv = + schema |> List.map (fun (n, d) -> n ^ "=" ^ d) |> String.concat "\n" + in + let card = + match cardinality with + | Conventions.Cardinality.Finite _ -> 0 + | Conventions.Cardinality.ConstrainedFinite -> 1 + | Conventions.Cardinality.AlephZero -> 2 + | Conventions.Cardinality.Continuum -> 3 + in + let (rc, path_opt) = + Nt_ffi.with_out_string (fun pp -> + Nt_ffi.rnt_register_ephemeral_relation session + (if named then 1 else 0) name cb (from_voidp void null) card + identity schema_kv (String.concat "\n" deps) pp) + in + match (rc, path_opt) with + | (0, Some path) -> + Hashtbl.replace retained_generators path cb; + Ok path + | (rc, _) -> Error (Error.handle_error rc ("register_ephemeral failed: " ^ name)) + + let drop_ephemeral ~(session : string) ~(name : string) : + (unit, Condition.t) result = + (* TODO: we leak the retained closure here. We can rebuild the path from + session + name (same formula as Sublanguage_context.ephemeral_path) and + Hashtbl.remove it, instead of holding onto one closure per dropped view + until a later re-registration overwrites it. *) + let rc = Nt_ffi.rnt_drop_ephemeral_relation session name in + if rc = 0 then Ok () + else Error (Error.handle_error rc ("drop_ephemeral failed: " ^ name)) + + (* -------------------------------------------------------------------------- Multigroup / branch mutations Each of these advances the underlying RNT branch to a new snapshot as a @@ -661,6 +773,13 @@ module type S = sig val open_relation : branch_name:string -> mg_name:string -> rel_name:string -> (relation_handle, Condition.t) result val close_relation : relation_handle -> (unit, Condition.t) result + val register_ephemeral : + session:string -> named:bool -> name:string -> + generator:(offset:int -> limit:int -> Tuple.materialized list) -> + cardinality:Conventions.Cardinality.t -> identity:string -> + schema:Schema.t -> deps:string list -> (string, Condition.t) result + val drop_ephemeral : session:string -> name:string -> (unit, Condition.t) result + val execute_query : plan_node -> rel_name:string -> (tuple_stream, Condition.t) result val stream_next : tuple_stream -> (Tuple.materialized option, Condition.t) result val stream_close : tuple_stream -> (unit, Condition.t) result diff --git a/lib/nt_ffi.ml b/lib/nt_ffi.ml index bfbdf65..6759a17 100644 --- a/lib/nt_ffi.ml +++ b/lib/nt_ffi.ml @@ -25,6 +25,27 @@ let rnt_session_set_branch = fn "rnt_session_set_branch" (string @-> string @-> string @-> returning int) +(* Ephemeral relations ------------------------------------------------------ *) + +(* rnt_generator_fn: (ctx, args, offset, limit, sink) -> int. + OCaml closures passed here cross into C; the closure must stay reachable + for as long as RNT may invoke it (Nt retains them, see + Nt.retained_generators). *) +let rnt_generator_fn = + funptr + (ptr void @-> string @-> size_t @-> size_t @-> ptr void @-> returning int) + +let rnt_sink_emit = + fn "rnt_sink_emit" (ptr void @-> string @-> returning int) + +let rnt_register_ephemeral_relation = + fn "rnt_register_ephemeral_relation" + (string @-> int @-> string @-> rnt_generator_fn @-> ptr void @-> int + @-> string @-> string @-> string @-> ptr (ptr char) @-> returning int) + +let rnt_drop_ephemeral_relation = + fn "rnt_drop_ephemeral_relation" (string @-> string @-> returning int) + (* Handle lifecycle -------------------------------------------------------- *) let rnt_open_handle = fn "rnt_open_handle" (string @-> ptr void @-> returning (ptr void)) @@ -84,72 +105,53 @@ let rnt_cursor_close = (* VM plan builder --------------------------------------------------------- *) -type operation = Scan | Join | Take | Project - -let int_of_operation = function - | Scan -> 1 | Join -> 2 | Take -> 3 | Project -> 4 - -let operation_of_int = function - | 1 -> Scan | 2 -> Join | 3 -> Take | 4 -> Project - | _ -> failwith "Bad operation" (* FIXME *) - -let operation = view ~read:operation_of_int ~write:int_of_operation int +(* For PlanAction in RNT_C_API.h, where one context struct per operator is laid + side by side (no unions unfortunately as ctypes has no union support 🤡, and + the C side reads only the member matching [operation]). Strings are passed + as [ptr char]; the caller owns the backing CArray and must keep it alive across + the rnt_plan_assemble call (the C side copies immediately). *) type plan_args_scan -let plan_args_scan : plan_args_scan structure typ = structure "plan_args_scan" -let pas_relation_path = field plan_args_scan "pas_relation_path" string +let plan_args_scan : plan_args_scan structure typ = structure "PlanArgsScan" +let scan_relation_path = field plan_args_scan "relation_path" (ptr char) let () = seal plan_args_scan type plan_args_join -let plan_args_join : plan_args_join structure typ = structure "plan_args_join" -let paj_left = field plan_args_join "paj_left" (ptr void) -let paj_right = field plan_args_join "paj_right" (ptr void) +let plan_args_join : plan_args_join structure typ = structure "PlanArgsJoin" +let join_left = field plan_args_join "left" (ptr void) +let join_right = field plan_args_join "right" (ptr void) let () = seal plan_args_join type plan_args_take -let plan_args_take : plan_args_take structure typ = structure "plan_args_take" -let pat_source = field plan_args_take "pat_source" (ptr void) -let pat_limit = field plan_args_take "pat_limit" size_t +let plan_args_take : plan_args_take structure typ = structure "PlanArgsTake" +let take_source = field plan_args_take "source" (ptr void) +let take_limit = field plan_args_take "limit" size_t let () = seal plan_args_take type plan_args_project -let plan_args_project : plan_args_project structure typ = structure "plan_args_project" -let pap_source = field plan_args_project "pap_source" (ptr void) -let pap_attrs = field plan_args_project "pap_attrs" (ptr (ptr char)) +let plan_args_project : plan_args_project structure typ = + structure "PlanArgsProject" +let project_source = field plan_args_project "source" (ptr void) +let project_attrs = field plan_args_project "attrs" (ptr (ptr char)) let () = seal plan_args_project type plan_action -let plan_action : plan_action structure typ = structure "plan_action" -let pa_operation = field plan_action "pa_operation" operation -let pa_scan = field plan_action "pa_scan" plan_args_scan -let pa_join = field plan_action "pa_join" plan_args_join -let pa_take = field plan_action "pa_take" plan_args_take -let pa_project = field plan_action "pa_project" plan_args_project +let plan_action : plan_action structure typ = structure "PlanAction" +let action_operation = field plan_action "operation" int +let action_scan = field plan_action "scan" plan_args_scan +let action_join = field plan_action "join" plan_args_join +let action_take = field plan_action "take" plan_args_take +let action_project = field plan_action "project" plan_args_project let () = seal plan_action -let rnt_plan_assemble = fn "rnt_plan_assemble" (plan_action @-> returning (ptr void)) - -let ( &-> ) = getf +(* nt::Operation values, RNT include/VM.h *) +let fol_operation_scan = 1 +let fol_operation_join = 2 +let fol_operation_take = 3 +let fol_operation_project = 4 -let rnt_plan_scan str = - let plan = make plan_action in - setf plan pa_operation Scan; - setf (plan &-> pa_scan) pas_relation_path str; - rnt_plan_assemble plan - -let rnt_plan_join left right = - let plan = make plan_action in - setf plan pa_operation Join; - setf (plan &-> pa_join) paj_left left; - setf (plan &-> pa_join) paj_right right; - rnt_plan_assemble plan - -let rnt_plan_take source limit = - let plan = make plan_action in - setf plan pa_operation Take; - setf (plan &-> pa_take) pat_source source; - setf (plan &-> pa_take) pat_limit limit; - rnt_plan_assemble plan +let rnt_plan_assemble = + fn "rnt_plan_assemble" (plan_action @-> returning (ptr void)) let rnt_plan_free = fn "rnt_plan_free" (ptr void @-> returning void) @@ -176,6 +178,13 @@ let rnt_free_bytes = let null_char_ptr : char ptr = from_voidp char null +let cstring (s : string) : char CArray.t = + let n = String.length s in + let arr = CArray.make char (n + 1) in + String.iteri (CArray.set arr) s; + CArray.set arr n '\000'; + arr + (* Reads a null-terminated C string from a char pointer, then frees it. *) let consume_cstring (p : char ptr) : string = let n = ref 0 in diff --git a/lib/sublanguage_context.ml b/lib/sublanguage_context.ml index 39e6dd3..40aa543 100644 --- a/lib/sublanguage_context.ml +++ b/lib/sublanguage_context.ml @@ -36,8 +36,18 @@ type t = { resolve : ?branch:string -> Qualified_name.t -> string; switch_branch : string -> (Sublanguage_types.transition_delta, Condition.t) result; + session_hash : string; + (** RNT session hash owning this connection. Session-scoped ephemeral + relations (with DML [Define]) register under + /system/sessions/<session_hash>/ephemeral/<name>. *) } +(** Absolute RNT path of a session-scoped ephemeral relation. An unqualified + name in a DRL [Base] resolves here: named bindings shadow nothing since + stored relations always carry an [mg:] qualifier. *) +let ephemeral_path (ctx : t) (name : string) : string = + "/system/sessions/" ^ ctx.session_hash ^ "/ephemeral/" ^ name + module Make (NT : Nt.S) = struct module Session = Session.Make (NT) module Branch = Branch.Make (NT) @@ -51,6 +61,7 @@ module Make (NT : Nt.S) = struct write_handle = br#branch_handle; branch = (br :> branch_view); resolve = br#path; + session_hash = session#id; switch_branch = fun name -> match br#close () with | Error e -> Error e |
