preparation cleanup for RNT integration

1 files changed, 0 insertions, 228 deletions

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)