aboutsummaryrefslogtreecommitdiffstats
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/dcl/ast.ml23
-rw-r--r--lib/dcl/executor.ml54
-rw-r--r--lib/dcl/parser.ml9
-rw-r--r--lib/dml/ast.ml22
-rw-r--r--lib/dml/executor.ml105
-rw-r--r--lib/dml/parser.ml9
-rw-r--r--lib/drl/ast.ml7
-rw-r--r--lib/drl/executor.ml7
8 files changed, 230 insertions, 6 deletions
diff --git a/lib/dcl/ast.ml b/lib/dcl/ast.ml
new file mode 100644
index 0000000..95e0271
--- /dev/null
+++ b/lib/dcl/ast.ml
@@ -0,0 +1,23 @@
+open Sexplib.Std
+
+type binding_expr =
+ | Var of string
+ | Const of Drl.Ast.value (** reuse DRL value for literals *)
+[@@deriving sexp]
+
+type constraint_body =
+ | MemberOf of { target: string; binding: (string * binding_expr) list }
+ | Not of { body: constraint_body; universe: string }
+ | And of constraint_body list
+ | Or of constraint_body list
+ | Exists of { variable: string; quantifier: string; body: constraint_body }
+ | Forall of { variable: string; quantifier: string; body: constraint_body }
+[@@deriving sexp]
+
+type statement =
+ | RegisterConstraint of {
+ constraint_name: string;
+ relation_name: string;
+ body: constraint_body;
+ }
+[@@deriving sexp]
diff --git a/lib/dcl/executor.ml b/lib/dcl/executor.ml
new file mode 100644
index 0000000..810781f
--- /dev/null
+++ b/lib/dcl/executor.ml
@@ -0,0 +1,54 @@
+module Make (Storage : Management.Physical.S) = struct
+ module Ops = Manipulation.Make(Storage)
+
+ type error =
+ | ManipulationError of Manipulation.error
+ | ConversionError of string
+
+ let wrap_manip = Result.map_error (fun e -> ManipulationError e)
+
+ (** Convert a DCL binding_expr to a runtime Constraint.binding_expr *)
+ let convert_binding_expr : Ast.binding_expr -> Constraint.binding_expr = function
+ | Ast.Var name -> Constraint.Var name
+ | Ast.Const value -> Constraint.Const (Drl.Ast.value_to_abstract value)
+
+ (** Convert a list of (target_attr, binding_expr) pairs to a Constraint.binding (BindingMap) *)
+ let convert_binding (pairs : (string * Ast.binding_expr) list) : Constraint.binding =
+ List.fold_left
+ (fun acc (key, expr) ->
+ Constraint.BindingMap.add key (convert_binding_expr expr) acc)
+ Constraint.BindingMap.empty
+ pairs
+
+ (** Convert a DCL constraint_body AST to a runtime Constraint.t *)
+ let rec convert_body : Ast.constraint_body -> Constraint.t = function
+ | Ast.MemberOf { target; binding } ->
+ Constraint.MemberOf { target; binding = convert_binding binding }
+ | Ast.Not { body; universe } ->
+ Constraint.Not { body = convert_body body; universe }
+ | Ast.And bodies ->
+ Constraint.And (List.map convert_body bodies)
+ | Ast.Or bodies ->
+ Constraint.Or (List.map convert_body bodies)
+ | Ast.Exists { variable; quantifier; body } ->
+ Constraint.Exists { variable; quantifier; body = convert_body body }
+ | Ast.Forall { variable; quantifier; body } ->
+ Constraint.Forall { variable; quantifier; body = convert_body body }
+
+ let execute
+ (storage : Storage.t)
+ (db : Management.Database.t)
+ (stmt : Ast.statement)
+ : (Management.Database.t, error) result =
+ match stmt with
+ | Ast.RegisterConstraint { constraint_name; relation_name; body } ->
+ (* TODO: Additional constraint operations (drop constraint, list constraints,
+ validate existing tuples against new constraint) are not supported via DCL.
+ Use the OCaml API for these advanced operations. *)
+ let runtime_body = convert_body body in
+ Ops.register_constraint storage db
+ ~constraint_name ~relation_name ~body:runtime_body
+ |> wrap_manip
+end
+
+module Memory = Make(Management.Physical.Memory)
diff --git a/lib/dcl/parser.ml b/lib/dcl/parser.ml
new file mode 100644
index 0000000..a7981c0
--- /dev/null
+++ b/lib/dcl/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
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
diff --git a/lib/drl/ast.ml b/lib/drl/ast.ml
index f94965d..2beb010 100644
--- a/lib/drl/ast.ml
+++ b/lib/drl/ast.ml
@@ -8,6 +8,13 @@ type value =
| Bool of bool
[@@deriving sexp]
+(** Convert an AST value to an AbstractValue.t (Obj.t) via Obj.repr *)
+let value_to_abstract : value -> Conventions.AbstractValue.t = function
+ | Int n -> Obj.repr n
+ | Float f -> Obj.repr f
+ | Str s -> Obj.repr s
+ | Bool b -> Obj.repr b
+
type direction = Asc | Desc
[@@deriving sexp]
diff --git a/lib/drl/executor.ml b/lib/drl/executor.ml
index 7588b33..27f52c2 100644
--- a/lib/drl/executor.ml
+++ b/lib/drl/executor.ml
@@ -8,12 +8,7 @@ module Make(Storage : Management.Physical.S) = struct
let wrap = Result.map_error (fun e -> AlgebraError e)
- (* Convert Ast.value → AbstractValue.t (Obj.t) via Obj.repr *)
- let ast_value_to_abstract : Ast.value -> Conventions.AbstractValue.t = function
- | Ast.Int n -> Obj.repr n
- | Ast.Float f -> Obj.repr f
- | Ast.Str s -> Obj.repr s
- | Ast.Bool b -> Obj.repr b
+ let ast_value_to_abstract = Ast.value_to_abstract
let rec execute
(storage : Storage.t)
generated by cgit v1.2.3 (git 2.25.1) at 2026-11-04 05:45:07 +0000