diff options
Diffstat (limited to '')
| -rw-r--r-- | lib/dml/ast.ml | 22 | ||||
| -rw-r--r-- | lib/dml/executor.ml | 105 | ||||
| -rw-r--r-- | lib/dml/parser.ml | 9 |
3 files changed, 136 insertions, 0 deletions
diff --git a/lib/dml/ast.ml b/lib/dml/ast.ml new file mode 100644 index 0000000..4a903e7 --- /dev/null +++ b/lib/dml/ast.ml @@ -0,0 +1,22 @@ +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 } +[@@deriving sexp] 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) diff --git a/lib/dml/parser.ml b/lib/dml/parser.ml new file mode 100644 index 0000000..a7981c0 --- /dev/null +++ b/lib/dml/parser.ml @@ -0,0 +1,9 @@ +type error = ParseError of string + +let of_string s = + match Sexplib.Sexp.of_string s |> Ast.statement_of_sexp with + | 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 |