1 files changed, 81 insertions, 69 deletions

diff --git a/lib/dml/executor.ml b/lib/dml/executor.ml
index 3a8b05a..7c08a24 100644
--- a/lib/dml/executor.ml
+++ b/lib/dml/executor.ml
@@ -1,19 +1,35 @@
 module Make (Storage : Management.Physical.S) = struct
   module Ops = Manipulation.Make(Storage)
+  module Alg = Algebra.Make(Storage)
+  module DrlExec = Drl.Executor.Make(Storage)
 
   type error =
+    | ParseError        of string
     | ManipulationError of Manipulation.error
-    | RelationNotFound of string
-    | ParseError of string
+    | RelationNotFound  of string
+    | AlgebraError      of Algebra.error
+
+  let sexp_of_error e =
+    let open Sexplib.Sexp in
+    match e with
+    | ParseError s                            -> List [Atom "parse-error";        Atom s]
+    | ManipulationError e                     -> Manipulation.sexp_of_error e
+    | RelationNotFound s                      -> List [Atom "relation-not-found"; Atom s]
+    | AlgebraError (Algebra.StorageError s)   -> List [Atom "storage-error";      Atom s]
+    | AlgebraError (Algebra.GeneratorError s) -> List [Atom "generator-error";    Atom s]
+
+  let ( let* ) = Result.bind
 
   let wrap_manip r = Result.map_error (fun e -> ManipulationError e) r
 
-  (** Convert a cardinality_spec AST node to a Conventions.Cardinality.t *)
-  let convert_cardinality : Ast.cardinality_spec -> Conventions.Cardinality.t = function
-    | Ast.Finite n -> Conventions.Cardinality.Finite n
-    | Ast.AlephZero -> Conventions.Cardinality.AlephZero
-    | Ast.Continuum -> Conventions.Cardinality.Continuum
-    | Ast.ConstrainedFinite -> Conventions.Cardinality.ConstrainedFinite
+  let wrap_alg e = AlgebraError e
+
+  let get_rel db name =
+    match Ops.get_relation db ~name with
+    | Some r -> Ok r
+    | None   -> Error (RelationNotFound name)
+
+  let retarget target (t : Tuple.materialized) = { t with Tuple.relation = target }
 
   (** Build a materialized tuple from a list of (attr_name, ast_value) pairs *)
   let build_tuple ~relation (attributes : Ast.attr_value list) : Tuple.materialized =
@@ -28,78 +44,74 @@ module Make (Storage : Management.Physical.S) = struct
     in
     { Tuple.relation; attributes = attr_map }
 
+  let eval_query storage db query =
+    match DrlExec.execute storage db query with
+    | Ok rel -> Ok rel
+    | Error (DrlExec.ParseError s)       -> Error (ParseError s)
+    | Error (DrlExec.RelationNotFound s) -> Error (RelationNotFound s)
+    | Error (DrlExec.AlgebraError e)     -> Error (AlgebraError e)
+
+  let materialize_tuples storage rel =
+    Result.map_error wrap_alg (Alg.materialize storage rel)
+
   let execute
       (storage : Storage.t)
       (db : Management.Database.t)
       (stmt : Ast.statement)
     : (Management.Database.t, error) result =
     match stmt with
-    | Ast.CreateDatabase name ->
-      Ops.create_database storage ~name |> wrap_manip
-
-    | Ast.CreateRelation { name; schema = schema_pairs } ->
-      let schema =
-        List.fold_left
-          (fun s (attr, dom) -> Schema.add attr dom s)
-          Schema.empty
-          schema_pairs
-      in
-      (match Ops.create_relation storage db ~name ~schema |> wrap_manip with
-       | Ok (db, _rel) -> Ok db
-       | Error e -> Error e)
-
-    | Ast.RetractRelation name ->
-      Ops.retract_relation storage db ~name |> wrap_manip
-
-    | Ast.ClearRelation name ->
-      (match Ops.get_relation db ~name with
-       | None -> Error (RelationNotFound name)
-       | Some rel ->
-         match Ops.clear_relation storage db rel |> wrap_manip with
-         | Ok (db, _rel) -> Ok db
-         | Error e -> Error e)
-
-    | Ast.RegisterDomain { name; cardinality } ->
-      (* TODO: Custom generators, membership_criteria, and comparators
-         are not supported via DML. Use the OCaml API for full-featured
-         domain definitions (e.g., custom enumeration, type-specific
-         comparison, or domain-specific validation). *)
-      let domain = Domain.make
-        ~name
-        ~generator:(fun _ -> Generator.Error "not enumerable via DML")
-        ~membership_criteria:(fun _ -> true)
-        ~cardinality:(convert_cardinality cardinality)
-        ~compare:Stdlib.compare
-      in
-      Ops.register_domain storage db domain |> wrap_manip
-
     | Ast.InsertTuple { relation; attributes } ->
-      (match Ops.get_relation db ~name:relation with
-       | None -> Error (RelationNotFound relation)
-       | Some rel ->
-         let tuple = build_tuple ~relation attributes in
-         match Ops.create_tuple storage db rel tuple |> wrap_manip with
-         | Ok (db, _rel, _hash) -> Ok db
-         | Error e -> Error e)
+      let* rel = get_rel db relation in
+      let tuple = build_tuple ~relation attributes in
+      let* (db, _, _) = Ops.create_tuple storage db rel tuple |> wrap_manip in
+      Ok db
 
     | Ast.InsertTuples { relation; tuples } ->
-      (match Ops.get_relation db ~name:relation with
-       | None -> Error (RelationNotFound relation)
-       | Some rel ->
-         let tuple_list = List.map (build_tuple ~relation) tuples in
-         match Ops.create_tuples storage db rel tuple_list |> wrap_manip with
-         | Ok (db, _rel, _hashes) -> Ok db
-         | Error e -> Error e)
+      let* rel = get_rel db relation in
+      let tuple_list = List.map (build_tuple ~relation) tuples in
+      let* (db, _, _) = Ops.create_tuples storage db rel tuple_list |> wrap_manip in
+      Ok db
 
     | Ast.DeleteTuple { relation; attributes } ->
-      (match Ops.get_relation db ~name:relation with
-       | None -> Error (RelationNotFound relation)
-       | Some rel ->
-         let tuple = build_tuple ~relation attributes in
-         let tuple_hash = Hashing.hash_tuple tuple in
-         match Ops.retract_tuple storage db rel ~tuple_hash |> wrap_manip with
-         | Ok (db, _rel) -> Ok db
-         | Error e -> Error e)
+      let* rel = get_rel db relation in
+      let tuple = build_tuple ~relation attributes in
+      let tuple_hash = Hashing.hash_tuple tuple in
+      let* (db, _) = Ops.retract_tuple storage db rel ~tuple_hash |> wrap_manip in
+      Ok db
+
+    | Ast.Assign { target; body } ->
+      let* rel        = get_rel db target in
+      let* result_rel = eval_query storage db body in
+      let* tuples     = materialize_tuples storage result_rel in
+      let* (db, rel)  = Ops.clear_relation storage db rel |> wrap_manip in
+      let* (db, _, _) = Ops.create_tuples storage db rel (List.map (retarget target) tuples) |> wrap_manip in
+      Ok db
+
+    | Ast.InsertFrom { target; source } ->
+      let* rel        = get_rel db target in
+      let* result_rel = eval_query storage db source in
+      let* tuples     = materialize_tuples storage result_rel in
+      let* (db, _, _) = Ops.create_tuples storage db rel (List.map (retarget target) tuples) |> wrap_manip in
+      Ok db
+
+    | Ast.DeleteWhere { target; predicate } ->
+      let* rel       = get_rel db target in
+      let* pred_rel  = eval_query storage db predicate in
+      let common     = List.filter_map
+        (fun (n, _) -> if List.exists (fun (m, _) -> m = n) pred_rel.Relation.schema
+                       then Some n else None)
+        rel.Relation.schema in
+      let* joined    = Alg.equijoin storage common rel pred_rel |> Result.map_error wrap_alg in
+      let* to_delete = Alg.project storage (List.map fst rel.Relation.schema) joined
+                       |> Result.map_error wrap_alg in
+      let* tuples    = materialize_tuples storage to_delete in
+      List.fold_left (fun acc t ->
+        let* db  = acc in
+        let* rel = get_rel db target in
+        let tuple_hash = Hashing.hash_tuple (retarget target t) in
+        let* (db, _) = Ops.retract_tuple storage db rel ~tuple_hash |> wrap_manip in
+        Ok db)
+        (Ok db) tuples
 end
 
 module Memory = Make(Management.Physical.Memory)