From e32ba6294781691846c3ab19281fe977350b4d0f Mon Sep 17 00:00:00 2001 From: Marcos Magueta Date: Sat, 26 Sep 2026 15:30:53 -0300 Subject: preparation cleanup for RNT integration --- lib/dml/ast.ml | 19 ----- lib/dml/executor.ml | 228 ------------------------------------------------- lib/dml/parser.ml | 17 ---- lib/dml/sublanguage.ml | 15 ---- 4 files changed, 279 deletions(-) delete mode 100644 lib/dml/ast.ml delete mode 100644 lib/dml/executor.ml delete mode 100644 lib/dml/parser.ml delete mode 100644 lib/dml/sublanguage.ml (limited to 'lib/dml') diff --git a/lib/dml/ast.ml b/lib/dml/ast.ml deleted file mode 100644 index e34adb9..0000000 --- a/lib/dml/ast.ml +++ /dev/null @@ -1,19 +0,0 @@ -open Sexplib.Std - -type attr_value = string * Drl.Ast.value [@@deriving sexp] - -type statement = - | InsertTuple of {relation: string; attributes: attr_value list} - | InsertTuples of {relation: string; tuples: attr_value list list} - | DeleteTuple of {relation: string; attributes: attr_value list} - | 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 deleted file mode 100644 index f034f4a..0000000 --- a/lib/dml/executor.ml +++ /dev/null @@ -1,228 +0,0 @@ -module Make (NT : Nt.S) = struct - module DrlExec = Drl.Executor.Make (NT) - - module Error = struct - open Condition - - (* TODO: more structure *) - let parse_error msg = condition "parse-error" msg empty - - let relation_not_found name = - condition "relation-not-found" "Relation not found" ("name" |=| of_string name) - - let multigroup_not_found name = - condition "multigroup-not-found" "Multigroup not found" ("name" |=| of_string name) - end - - let ( let* ) = Result.bind - let parse_fqn (s : string) : (Qualified_name.t, Condition.t) result = Qualified_name.try_parse s - - let lookup_mg (ctx : Sublanguage_context.t) (mg_name : string) : - (Management.Multigroup.multigroup, Condition.t) result = - match ctx.branch#mg_of mg_name with - | Some mg -> Ok mg - | None -> Error (Error.multigroup_not_found mg_name) - - let get_rel (ctx : Sublanguage_context.t) (fqn : Qualified_name.t) = - let* mg = lookup_mg ctx fqn.mg in - match NT.get_relation mg fqn.name with - | Some r -> Ok r - | None -> Error (Error.relation_not_found (Qualified_name.to_string fqn)) - - let retarget target (t : Tuple.materialized) = {t with Tuple.relation= target} - - let build_tuple ~relation (attributes : Ast.attr_value list) : Tuple.materialized = - let attr_map = - List.fold_left - (fun acc (name, value) -> - Tuple.AttributeMap.add name {Attribute.value= Drl.Ast.value_to_abstract value} acc ) - Tuple.AttributeMap.empty attributes - in - {Tuple.relation; attributes= attr_map} - - (* 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 query in - let* stream = NT.execute_query plan ~rel_name:"dml_drain" in - let rec drain acc = - match NT.stream_next stream with - | Error _ -> List.rev acc - | Ok None -> List.rev acc - | Ok (Some t) -> drain (t :: acc) - in - let tuples = drain [] in - 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 - - let tuple_matches_pred common (target_t : Tuple.materialized) (pred_t : Tuple.materialized) = - List.for_all - (fun attr -> - match - ( Tuple.AttributeMap.find_opt attr target_t.Tuple.attributes, - Tuple.AttributeMap.find_opt attr pred_t.Tuple.attributes ) - with - | Some a, Some b -> attr_val_eq a b - | _ -> false ) - common - - let semijoin common target_tuples pred_tuples = - List.filter (fun t -> List.exists (tuple_matches_pred common t) pred_tuples) target_tuples - - (* DML mutates tuples in a single mg per statement. Returns a - single-element transition delta keyed by that mg's name. *) - let execute (ctx : Sublanguage_context.t) (stmt : Ast.statement) : - (Sublanguage_types.transition_delta, Condition.t) result = - let bh = ctx.write_handle in - let branch_name = ctx.branch#name in - let after fqn = - Result.bind (lookup_mg ctx fqn.Qualified_name.mg) (fun mg -> Ok [fqn.Qualified_name.mg, mg]) - in - match stmt with - | Ast.InsertTuple {relation; attributes} -> - let* fqn = parse_fqn relation in - let* rel = get_rel ctx fqn in - let tuple = build_tuple ~relation:rel#name attributes in - let* _ = NT.create_tuple ~branch_name ~mg_name:fqn.mg ~rel_name:rel#name tuple in - after fqn - | Ast.InsertTuples {relation; tuples} -> - let* fqn = parse_fqn relation in - let* rel = get_rel ctx fqn in - let tuple_list = List.map (build_tuple ~relation:rel#name) tuples in - let* _ = NT.create_tuples ~branch_name ~mg_name:fqn.mg ~rel_name:rel#name tuple_list in - after fqn - | Ast.DeleteTuple {relation; attributes} -> - let* fqn = parse_fqn relation in - let* rel = get_rel ctx fqn in - let tuple = build_tuple ~relation:rel#name attributes in - let hash = Hashing.hash_tuple tuple in - let* () = NT.retract_tuple ~branch_name ~mg_name:fqn.mg ~rel_name:rel#name hash in - after fqn - | Ast.Assign {target; body} -> - let* fqn = parse_fqn target in - let* mg = lookup_mg ctx fqn.mg in - let* rel = get_rel ctx fqn in - let* tuples = drain_query ctx body in - let* _bh, new_mg = - NT.clear_relation bh mg ~branch_name ~mg_name:fqn.mg (rel :> Relation.relation) - in - ctx.branch#set_mg ~name:fqn.mg new_mg; - let* _ = - NT.create_tuples ~branch_name ~mg_name:fqn.mg ~rel_name:rel#name - (List.map (retarget rel#name) tuples) - in - Ok [fqn.mg, new_mg] - | Ast.InsertFrom {target; source} -> - let* fqn = parse_fqn target in - let* rel = get_rel ctx fqn in - let* tuples = drain_query ctx source in - let* _ = - NT.create_tuples ~branch_name ~mg_name:fqn.mg ~rel_name:rel#name - (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 - let* target_tuples = drain_query ctx (Drl.Ast.Base target) in - let* pred_tuples = drain_query ctx predicate in - let attr_names_of = function - | [] -> [] - | t :: _ -> List.map fst (Tuple.AttributeMap.bindings t.Tuple.attributes) - in - let target_attrs = attr_names_of target_tuples in - let pred_attrs = attr_names_of pred_tuples in - let common = List.filter (fun n -> List.mem n pred_attrs) target_attrs in - let to_delete = semijoin common target_tuples pred_tuples in - let* () = - List.fold_left - (fun acc t -> - let* () = acc in - let hash = Hashing.hash_tuple (retarget rel#name t) in - NT.retract_tuple ~branch_name ~mg_name:fqn.mg ~rel_name:rel#name hash ) - (Ok ()) to_delete - in - after fqn -end - -module Memory = Make (Nt.Memory) diff --git a/lib/dml/parser.ml b/lib/dml/parser.ml deleted file mode 100644 index 094b0fd..0000000 --- a/lib/dml/parser.ml +++ /dev/null @@ -1,17 +0,0 @@ -module Error = struct - open Condition - - let parse_error msg = condition "parse-error" msg empty -end - -let of_sexp sexp = - match Ast.statement_of_sexp sexp with - | stmt -> Ok stmt - | exception exn -> Error (Error.parse_error (Printexc.to_string exn)) - -let of_string s = - match Sexplib.Sexp.of_string s |> Ast.statement_of_sexp with - | stmt -> Ok stmt - | exception exn -> Error (Error.parse_error (Printexc.to_string exn)) - -let to_string stmt = Ast.sexp_of_statement stmt |> Sexplib.Sexp.to_string_hum diff --git a/lib/dml/sublanguage.ml b/lib/dml/sublanguage.ml deleted file mode 100644 index 6e9d2c8..0000000 --- a/lib/dml/sublanguage.ml +++ /dev/null @@ -1,15 +0,0 @@ -module Make (NT : Nt.S) = struct - module Exec = Executor.Make (NT) - - type configuration = unit - type ast = Ast.statement - - let name = "dml" - let parse _ = Ok () - let parse_sexp sexp = Parser.of_sexp sexp - - let execute ctx ast = - match Exec.execute ctx ast with - | Ok delta -> Ok (Sublanguage_types.Transition delta) - | Error e -> Error e -end -- cgit v1.2.3