aboutsummaryrefslogtreecommitdiffstats
path: root/lib/system.ml
diff options
context:
space:
mode:
authorMarcos Magueta <maguetamarcos@gmail.com>2026-04-27 13:00:30 -0300
committerGitHub <noreply@github.com>2026-04-27 13:00:30 -0300
commit56492ad5f6f09d8c9f337d42803b64d1b9f0668b (patch)
tree0a41825d319fe47e037e2e30ed515c3c2d9b0d7d /lib/system.ml
parent12f170f438f5909511da2f26c5d33a85acc1fe64 (diff)
downloadSakura-56492ad5f6f09d8c9f337d42803b64d1b9f0668b.tar.gz
Sakura-56492ad5f6f09d8c9f337d42803b64d1b9f0668b.zip
Introduce Multigroups (#65)
Diffstat (limited to 'lib/system.ml')
-rw-r--r--lib/system.ml37
1 files changed, 4 insertions, 33 deletions
diff --git a/lib/system.ml b/lib/system.ml
index 4280dda..14ef089 100644
--- a/lib/system.ml
+++ b/lib/system.ml
@@ -38,33 +38,6 @@ let registry : registry =
let transport = Transport.TCP.create config in
Ok (TransportParcel ((module Transport.TCP), transport))) }
-let initialize_multigroup create_immutable_relation storage multigroup =
- let open Prelude.Standard in
- List.fold_left
- (fun multigroup (rel : Relation.t) ->
- match
- create_immutable_relation storage multigroup ~name:rel.name
- ~schema:rel.schema ~generator:(Option.get rel.generator)
- ~membership_criteria:rel.membership_criteria
- ~cardinality:rel.cardinality
- with
- | Ok (new_multigroup, _) -> new_multigroup
- | Error e ->
- Printf.eprintf
- "Warning: failed to register prelude relation %s: %s\n%!" rel.name
- (Sexplib.Sexp.to_string (Error.sexp_of_error e));
- multigroup)
- multigroup
- [ less_than_natural;
- less_than_or_equal_natural;
- greater_than_natural;
- greater_than_or_equal_natural;
- equal_natural;
- not_equal_natural;
- plus_natural;
- times_natural;
- minus_natural;
- divide_natural ]
let assemble (config : Configuration.t) : (unit -> unit, string) result =
let open Utilities.Result in
@@ -93,15 +66,13 @@ let assemble (config : Configuration.t) : (unit -> unit, string) result =
let* packed_transport = transport_provider transport_body in
let (StorageParcel ((module S), storage)) = packed_storage in
let (TransportParcel ((module T), transport)) = packed_transport in
- let module Manip = Manipulation.Make (S) in
- let* multigroup =
- Manip.create_database storage ~name:"sakura"
- |> Result.map (initialize_multigroup Manip.create_immutable_relation storage)
- |> Result.map_error (fun _ -> "Failed to create initial database")
+ let module C = Catalog.Make (S) in
+ let* catalog =
+ C.create storage ~prelude_relations:Prelude.Standard.prelude_relations
in
let module L = Listener.Make (T) (S) in
Ok (fun () -> Scl.Executor.set_sessions (Session.create ());
- L.run transport multigroup storage)
+ L.run transport catalog storage)
let run_from_config (path : string) : (unit -> unit, string) result =
let ( let* ) = Result.bind in