diff options
| author | Marcos Magueta <maguetamarcos@gmail.com> | 2026-04-03 16:17:38 -0300 |
|---|---|---|
| committer | Marcos Magueta <maguetamarcos@gmail.com> | 2026-04-03 16:17:38 -0300 |
| commit | 63ae3c930de89af6f85229a467caa3f53cb844a2 (patch) | |
| tree | cda4d513672f9fefa09c3a1dff69d8443890e224 /lib/dml | |
| parent | c5bc3a4992b4968780c286a084ad7c02b2b58f1e (diff) | |
| download | Sakura-63ae3c930de89af6f85229a467caa3f53cb844a2.tar.gz Sakura-63ae3c930de89af6f85229a467caa3f53cb844a2.zip | |
format
Diffstat (limited to 'lib/dml')
| -rw-r--r-- | lib/dml/ast.ml | 15 | ||||
| -rw-r--r-- | lib/dml/executor.ml | 156 | ||||
| -rw-r--r-- | lib/dml/parser.ml | 7 | ||||
| -rw-r--r-- | lib/dml/sublanguage.ml | 8 |
4 files changed, 99 insertions, 87 deletions
diff --git a/lib/dml/ast.ml b/lib/dml/ast.ml index 479437a..d8defe6 100644 --- a/lib/dml/ast.ml +++ b/lib/dml/ast.ml @@ -1,13 +1,12 @@ open Sexplib.Std -type attr_value = string * Drl.Ast.value -[@@deriving sexp] +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 } + | 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 7c08a24..08f1a26 100644 --- a/lib/dml/executor.ml +++ b/lib/dml/executor.ml @@ -1,117 +1,131 @@ module Make (Storage : Management.Physical.S) = struct - module Ops = Manipulation.Make(Storage) - module Alg = Algebra.Make(Storage) - module DrlExec = Drl.Executor.Make(Storage) + module Ops = Manipulation.Make (Storage) + module Alg = Algebra.Make (Storage) + module DrlExec = Drl.Executor.Make (Storage) type error = - | ParseError of string + | ParseError of string | ManipulationError of Manipulation.error - | RelationNotFound of string - | AlgebraError of Algebra.error + | 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] + | 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 - 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) + | None -> Error (RelationNotFound name) - let retarget target (t : Tuple.materialized) = { t with Tuple.relation = target } + 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 = + 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 + Tuple.AttributeMap.empty attributes 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.ParseError s) -> Error (ParseError s) | Error (DrlExec.RelationNotFound s) -> Error (RelationNotFound s) - | Error (DrlExec.AlgebraError e) -> Error (AlgebraError e) + | 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 = + let execute (storage : Storage.t) (db : Management.Database.t) + (stmt : Ast.statement) : (Management.Database.t, error) result = match stmt with | Ast.InsertTuple { relation; attributes } -> - 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 - + 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 } -> - 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 - + 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 } -> - 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 - + 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 - + 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 - + 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 + 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) +module Memory = Make (Management.Physical.Memory) diff --git a/lib/dml/parser.ml b/lib/dml/parser.ml index 28f8b6c..5678b47 100644 --- a/lib/dml/parser.ml +++ b/lib/dml/parser.ml @@ -2,13 +2,12 @@ type error = ParseError of string let of_sexp sexp = match Ast.statement_of_sexp sexp with - | stmt -> Ok stmt + | 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 + | stmt -> Ok stmt | exception exn -> Error (ParseError (Printexc.to_string exn)) -let to_string stmt = - Ast.sexp_of_statement stmt |> Sexplib.Sexp.to_string_hum +let to_string stmt = Ast.sexp_of_statement stmt |> Sexplib.Sexp.to_string_hum diff --git a/lib/dml/sublanguage.ml b/lib/dml/sublanguage.ml index 29f951e..29b1b77 100644 --- a/lib/dml/sublanguage.ml +++ b/lib/dml/sublanguage.ml @@ -1,9 +1,9 @@ module Make (Storage : Management.Physical.S) = struct - module Exec = Executor.Make(Storage) + module Exec = Executor.Make (Storage) type storage = Storage.t - type ast = Ast.statement - type error = Exec.error + type ast = Ast.statement + type error = Exec.error let name = "dml" @@ -20,4 +20,4 @@ module Make (Storage : Management.Physical.S) = struct let sexp_of_error = Exec.sexp_of_error end -module Memory = Make(Management.Physical.Memory) +module Memory = Make (Management.Physical.Memory) |
