Sublanguages improvement & Coq experiment (#53)

* separation and functor for sublanguages

* add coq experiment for termination

* fix tests with envelopes

* add timestamp and print responses to server on terminal

* remove coq experiment for trivial cases and rework gate

* refactor nesting with let*

* remove non-envelope sublang support and tests on server

* manip_err duplication purge and better format as s-expr

* abstract storage with dispatch for sublanguages

* dead code and minor refactor due to old non-envelope parsing on subl

* refactor server to use proper dml alg error and wire ephem relations

* remove (schema)

* change .gitignore to blacklist folders

4 files changed, 112 insertions, 81 deletions

diff --git a/lib/dml/ast.ml b/lib/dml/ast.ml
index 4a903e7..479437a 100644
--- a/lib/dml/ast.ml
+++ b/lib/dml/ast.ml
@@ -3,20 +3,11 @@ open Sexplib.Std
 type attr_value = string * Drl.Ast.value
 [@@deriving sexp]
 
-type cardinality_spec =
-  | Finite of int
-  | AlephZero
-  | Continuum
-  | ConstrainedFinite
-[@@deriving sexp]
-
 type statement =
-  | CreateDatabase of string
-  | CreateRelation of { name: string; schema: (string * string) list }
-  | RetractRelation of string
-  | ClearRelation of string
-  | RegisterDomain of { name: string; cardinality: cardinality_spec }
   | 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 }
 [@@deriving sexp]
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)
diff --git a/lib/dml/parser.ml b/lib/dml/parser.ml
index a7981c0..28f8b6c 100644
--- a/lib/dml/parser.ml
+++ b/lib/dml/parser.ml
@@ -1,5 +1,10 @@
 type error = ParseError of string
 
+let of_sexp sexp =
+  match Ast.statement_of_sexp sexp with
+  | stmt          -> Ok stmt
+  | exception exn -> Error (ParseError (Printexc.to_string exn))
+
 let of_string s =
   match Sexplib.Sexp.of_string s |> Ast.statement_of_sexp with
   | stmt          -> Ok stmt
diff --git a/lib/dml/sublanguage.ml b/lib/dml/sublanguage.ml
new file mode 100644
index 0000000..29f951e
--- /dev/null
+++ b/lib/dml/sublanguage.ml
@@ -0,0 +1,23 @@
+module Make (Storage : Management.Physical.S) = struct
+  module Exec = Executor.Make(Storage)
+
+  type storage = Storage.t
+  type ast     = Ast.statement
+  type error   = Exec.error
+
+  let name = "dml"
+
+  let parse_sexp sexp =
+    match Parser.of_sexp sexp with
+    | Ok r -> Ok r
+    | Error (Parser.ParseError s) -> Error (Exec.ParseError s)
+
+  let execute storage db ast =
+    match Exec.execute storage db ast with
+    | Ok db -> Ok (Sublanguage.Transition (db, "updated"))
+    | Error e -> Error e
+
+  let sexp_of_error = Exec.sexp_of_error
+end
+
+module Memory = Make(Management.Physical.Memory)