Format

4 files changed, 89 insertions, 112 deletions

diff --git a/lib/dml/ast.ml b/lib/dml/ast.ml
index 03e68ac..e34adb9 100644
--- a/lib/dml/ast.ml
+++ b/lib/dml/ast.ml
@@ -3,18 +3,17 @@ 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 }
+  | 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
index d5c55f8..f034f4a 100644
--- a/lib/dml/executor.ml
+++ b/lib/dml/executor.ml
@@ -3,16 +3,19 @@ module Make (NT : Nt.S) = struct
 
   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))
+
+    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 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 =
@@ -26,27 +29,22 @@ module Make (NT : Nt.S) = struct
     | 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 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.add name {Attribute.value= Drl.Ast.value_to_abstract value} acc )
         Tuple.AttributeMap.empty attributes
     in
-    { Tuple.relation; attributes = attr_map }
+    {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* stream = NT.execute_query plan ~rel_name:"dml_drain" in
     let rec drain acc =
       match NT.stream_next stream with
       | Error _ -> List.rev acc
@@ -60,38 +58,36 @@ module Make (NT : Nt.S) = struct
   (* 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 =
+  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.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
+     |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
+    | 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)
+          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
@@ -102,31 +98,28 @@ module Make (NT : Nt.S) = struct
         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)
+        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)
+  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
+    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. *)
@@ -134,52 +127,44 @@ module Make (NT : Nt.S) = struct
       (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) ])
+    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 } ->
+    | 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
+        let* _ = NT.create_tuple ~branch_name ~mg_name:fqn.mg ~rel_name:rel#name tuple in
         after fqn
-    | Ast.InsertTuples { relation; tuples } ->
+    | 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
+        let* _ = NT.create_tuples ~branch_name ~mg_name:fqn.mg ~rel_name:rel#name tuple_list in
         after fqn
-    | Ast.DeleteTuple { relation; attributes } ->
+    | 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
+        let* () = NT.retract_tuple ~branch_name ~mg_name:fqn.mg ~rel_name:rel#name hash in
         after fqn
-    | Ast.Assign { target; body } ->
+    | Ast.Assign {target; body} ->
         let* fqn = parse_fqn target in
-        let* mg  = lookup_mg ctx fqn.mg 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)
+          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 } ->
+        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
@@ -188,11 +173,11 @@ module Make (NT : Nt.S) = struct
             (List.map (retarget rel#name) tuples)
         in
         after fqn
-    | Ast.Define { target; body } ->
+    | Ast.Define {target; body} ->
         let* () =
           if String.contains target ':' then
-            Error (Error.parse_error
-              ("Define target must be unqualified (session-scoped): " ^ target))
+            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
@@ -204,35 +189,29 @@ module Make (NT : Nt.S) = struct
            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
+          | 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
+          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)
+            ~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
+    | Ast.DropDefine {target} ->
+        let* () = NT.drop_ephemeral ~session:ctx.session_hash ~name:target in
         Ok []
-    | Ast.DeleteWhere { target; predicate } ->
+    | 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* pred_tuples = drain_query ctx predicate in
         let attr_names_of = function
           | [] -> []
-          | t :: _ ->
-              List.map fst (Tuple.AttributeMap.bindings t.Tuple.attributes)
+          | 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 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* () =
@@ -240,8 +219,7 @@ module Make (NT : Nt.S) = struct
             (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)
+              NT.retract_tuple ~branch_name ~mg_name:fqn.mg ~rel_name:rel#name hash )
             (Ok ()) to_delete
         in
         after fqn
diff --git a/lib/dml/parser.ml b/lib/dml/parser.ml
index a4df914..094b0fd 100644
--- a/lib/dml/parser.ml
+++ b/lib/dml/parser.ml
@@ -1,5 +1,6 @@
 module Error = struct
   open Condition
+
   let parse_error msg = condition "parse-error" msg empty
 end
 
diff --git a/lib/dml/sublanguage.ml b/lib/dml/sublanguage.ml
index 9648786..6e9d2c8 100644
--- a/lib/dml/sublanguage.ml
+++ b/lib/dml/sublanguage.ml
@@ -6,7 +6,6 @@ module Make (NT : Nt.S) = struct
 
   let name = "dml"
   let parse _ = Ok ()
-
   let parse_sexp sexp = Parser.of_sexp sexp
 
   let execute ctx ast =