aboutsummaryrefslogtreecommitdiffstats
path: root/lib/dml/executor.ml
diff options
context:
space:
mode:
authorMarcos Magueta <maguetamarcos@gmail.com>2026-03-08 20:36:31 -0300
committerMarcos Magueta <maguetamarcos@gmail.com>2026-03-08 20:36:31 -0300
commite10acd09faf53c636b653c4df034716545db5fab (patch)
tree570d34526016df383a4b1821d9fe1dc864ef0c16 /lib/dml/executor.ml
parent99ac1e7d9b77d69f2a85a108468d4433953d8269 (diff)
downloadSakura-e10acd09faf53c636b653c4df034716545db5fab.tar.gz
Sakura-e10acd09faf53c636b653c4df034716545db5fab.zip
dml and dcl
Diffstat (limited to 'lib/dml/executor.ml')
-rw-r--r--lib/dml/executor.ml105
1 files changed, 105 insertions, 0 deletions
diff --git a/lib/dml/executor.ml b/lib/dml/executor.ml
new file mode 100644
index 0000000..3a8b05a
--- /dev/null
+++ b/lib/dml/executor.ml
@@ -0,0 +1,105 @@
+module Make (Storage : Management.Physical.S) = struct
+ module Ops = Manipulation.Make(Storage)
+
+ type error =
+ | ManipulationError of Manipulation.error
+ | RelationNotFound of string
+ | ParseError of string
+
+ 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
+
+ (** Build a materialized tuple from a list of (attr_name, ast_value) pairs *)
+ 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 }
+
+ 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)
+
+ | 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)
+
+ | 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)
+end
+
+module Memory = Make(Management.Physical.Memory)