aboutsummaryrefslogtreecommitdiffstats
path: root/lib/ddl
diff options
context:
space:
mode:
authorMarcos Magueta <maguetamarcos@gmail.com>2026-09-26 15:30:53 -0300
committerMarcos Magueta <maguetamarcos@gmail.com>2026-09-26 15:30:53 -0300
commite32ba6294781691846c3ab19281fe977350b4d0f (patch)
treef38e92ba2fc03e966d7263c7ee2e0b5d7983ebae /lib/ddl
parentbe375a52da6174dfda5b68617d27e1542cc80499 (diff)
downloadSakura-e32ba6294781691846c3ab19281fe977350b4d0f.tar.gz
Sakura-e32ba6294781691846c3ab19281fe977350b4d0f.zip
preparation cleanup for RNT integration
Diffstat (limited to 'lib/ddl')
-rw-r--r--lib/ddl/ast.ml12
-rw-r--r--lib/ddl/executor.ml81
-rw-r--r--lib/ddl/parser.ml17
-rw-r--r--lib/ddl/sublanguage.ml15
4 files changed, 0 insertions, 125 deletions
diff --git a/lib/ddl/ast.ml b/lib/ddl/ast.ml
deleted file mode 100644
index 86af755..0000000
--- a/lib/ddl/ast.ml
+++ /dev/null
@@ -1,12 +0,0 @@
-open Sexplib.Std
-
-type cardinality_spec = Finite of int | AlephZero | Continuum | ConstrainedFinite
-[@@deriving sexp]
-
-type statement =
- | CreateMultigroup of string
- | CreateRelation of {name: string; schema: (string * string) list}
- | RetractRelation of string
- | ClearRelation of string
- | RegisterDomain of {name: string; cardinality: cardinality_spec}
-[@@deriving sexp]
diff --git a/lib/ddl/executor.ml b/lib/ddl/executor.ml
deleted file mode 100644
index c16ff1f..0000000
--- a/lib/ddl/executor.ml
+++ /dev/null
@@ -1,81 +0,0 @@
-module Make (NT : Nt.S) = struct
- module Error = struct
- open Condition
-
- (* TODO: more structure *)
- let relation_not_found name =
- condition "relation-not-found" "Relation not found" ("name" |=| of_string name)
-
- let multigroup_not_found name =
- condition "multigroup-not-found" "Multigroup not found" ("name" |=| of_string name)
- end
-
- let ( let* ) = Result.bind
- let parse_fqn (s : string) : (Qualified_name.t, Condition.t) result = Qualified_name.try_parse s
-
- let lookup_mg (ctx : Sublanguage_context.t) (mg_name : string) :
- (Management.Multigroup.multigroup, Condition.t) result =
- match ctx.branch#mg_of mg_name with
- | Some mg -> Ok mg
- | None -> Error (Error.multigroup_not_found mg_name)
-
- 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
-
- (* Every relation-touching statement names exactly one mg via its FQN
- prefix. The executor parses the FQN, resolves the mg in the branch
- cache, advances it through NT, and returns a single-element delta. *)
- let execute (ctx : Sublanguage_context.t) (stmt : Ast.statement) :
- (Sublanguage_types.transition_delta * string, Condition.t) result =
- let bh = ctx.write_handle in
- let branch_name = ctx.branch#name in
- match stmt with
- | Ast.CreateMultigroup name -> (
- ctx.branch#add_multigroup ~name;
- match ctx.branch#mg_of name with
- | Some mg -> Ok ([name, mg], "Multigroup created: " ^ name)
- | None -> Error (Error.multigroup_not_found name) )
- | Ast.CreateRelation {name; schema= schema_pairs} ->
- let* fqn = parse_fqn name in
- let* mg = lookup_mg ctx fqn.mg in
- let schema =
- List.fold_left (fun s (attr, dom) -> Schema.add attr dom s) Schema.empty schema_pairs
- in
- let* _bh, new_mg = NT.create_relation bh mg ~branch_name ~name:fqn.name ~schema in
- ctx.branch#set_mg ~name:fqn.mg new_mg;
- Ok ([fqn.mg, new_mg], "Relation created: " ^ name)
- | Ast.RetractRelation name ->
- let* fqn = parse_fqn name in
- let* mg = lookup_mg ctx fqn.mg in
- let* _bh, new_mg = NT.retract_relation bh mg ~name:fqn.name in
- ctx.branch#set_mg ~name:fqn.mg new_mg;
- Ok ([fqn.mg, new_mg], "Relation retracted: " ^ name)
- | Ast.ClearRelation name -> (
- let* fqn = parse_fqn name in
- let* mg = lookup_mg ctx fqn.mg in
- match mg#get_relation fqn.name with
- | None -> Error (Error.relation_not_found name)
- | Some rel ->
- let* _bh, new_mg =
- NT.clear_relation bh mg ~branch_name ~mg_name:fqn.mg (rel :> Relation.relation)
- in
- ctx.branch#set_mg ~name:fqn.mg new_mg;
- Ok ([fqn.mg, new_mg], "Relation cleared: " ^ name) )
- | Ast.RegisterDomain {name; cardinality} ->
- let* fqn = parse_fqn name in
- let* mg = lookup_mg ctx fqn.mg in
- let domain : Relation.domain =
- new Relation.domain
- ~name:fqn.name
- ~generator:(fun _ -> Generator.Error "not enumerable via DDL")
- ~membership_criteria:(fun _ -> true)
- ~cardinality:(convert_cardinality cardinality) ~schema:Schema.empty ~provenance:None
- ~lineage:None ~constraints:None
- in
- let* _bh, new_mg = NT.register_domain bh mg domain in
- ctx.branch#set_mg ~name:fqn.mg new_mg;
- Ok ([fqn.mg, new_mg], "Domain registered: " ^ name)
-end
diff --git a/lib/ddl/parser.ml b/lib/ddl/parser.ml
deleted file mode 100644
index 094b0fd..0000000
--- a/lib/ddl/parser.ml
+++ /dev/null
@@ -1,17 +0,0 @@
-module Error = struct
- open Condition
-
- let parse_error msg = condition "parse-error" msg empty
-end
-
-let of_sexp sexp =
- match Ast.statement_of_sexp sexp with
- | stmt -> Ok stmt
- | exception exn -> Error (Error.parse_error (Printexc.to_string exn))
-
-let of_string s =
- match Sexplib.Sexp.of_string s |> Ast.statement_of_sexp with
- | stmt -> Ok stmt
- | exception exn -> Error (Error.parse_error (Printexc.to_string exn))
-
-let to_string stmt = Ast.sexp_of_statement stmt |> Sexplib.Sexp.to_string_hum
diff --git a/lib/ddl/sublanguage.ml b/lib/ddl/sublanguage.ml
deleted file mode 100644
index da3ba3a..0000000
--- a/lib/ddl/sublanguage.ml
+++ /dev/null
@@ -1,15 +0,0 @@
-module Make (NT : Nt.S) = struct
- module Exec = Executor.Make (NT)
-
- type configuration = unit
- type ast = Ast.statement
-
- let name = "ddl"
- let parse _ = Ok ()
- let parse_sexp sexp = Parser.of_sexp sexp
-
- let execute ctx ast =
- match Exec.execute ctx ast with
- | Ok (delta, _msg) -> Ok (Sublanguage_types.Transition delta)
- | Error e -> Error e
-end