aboutsummaryrefslogblamecommitdiffstats
path: root/lib/dml/executor.ml
blob: 3a8b05ad1238d0ae873f1ab39f3142b1a2dad645 (plain) (tree)








































































































                                                                                        
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)