aboutsummaryrefslogtreecommitdiffstats
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/algebra.ml29
-rw-r--r--lib/catalog.ml110
-rw-r--r--lib/configuration.ml6
-rw-r--r--lib/conventions.ml3
-rw-r--r--lib/dcl/sublanguage.ml6
-rw-r--r--lib/ddl/executor.ml4
-rw-r--r--lib/dml/executor.ml16
-rw-r--r--lib/drl/executor.ml24
-rw-r--r--lib/envelope.ml9
-rw-r--r--lib/error.ml38
-rw-r--r--lib/icl/executor.ml4
-rw-r--r--lib/listener.ml5
-rw-r--r--lib/management/branch.ml6
-rw-r--r--lib/management/merge.ml7
-rw-r--r--lib/manipulation.ml20
-rw-r--r--lib/prelude/catalog.ml18
-rw-r--r--lib/prelude/standard.ml159
-rw-r--r--lib/prl/executor.ml18
-rw-r--r--lib/prl/runtime.ml25
-rw-r--r--lib/qualified_name.ml6
-rw-r--r--lib/qualified_name.mli16
-rw-r--r--lib/relation.ml3
-rw-r--r--lib/session.ml6
-rw-r--r--lib/system.ml29
-rw-r--r--lib/transport.ml34
-rw-r--r--lib/utilities.ml4
26 files changed, 309 insertions, 296 deletions
diff --git a/lib/algebra.ml b/lib/algebra.ml
index d1eb26f..41b2256 100644
--- a/lib/algebra.ml
+++ b/lib/algebra.ml
@@ -46,8 +46,7 @@ module Make (Storage : Management.Physical.S) = struct
~generator:(Some gen)
~membership_criteria:(fun _ _ -> true)
~provenance:Relation.Provenance.Undefined
- ~lineage:(Relation.Lineage.Base "derived")
- ()
+ ~lineage:(Relation.Lineage.Base "derived") ()
let const_relation (pairs : (string * Conventions.AbstractValue.t) list) :
Relation.t =
@@ -224,8 +223,7 @@ module Make (Storage : Management.Physical.S) = struct
let matches =
List.filter_map
(fun rt ->
- if get_vals attrs rt = lv then Some (merge lt rt)
- else None)
+ if get_vals attrs rt = lv then Some (merge lt rt) else None)
right_tuples
in
match matches with
@@ -254,15 +252,15 @@ module Make (Storage : Management.Physical.S) = struct
let left_gen = to_generator storage left in
let make_right_producer_join_gen lgen =
let rec from_left lgen lpos =
- fun _pos ->
+ fun _pos ->
match lgen (Some lpos) with
| Generator.Done -> Generator.Done
| Generator.Error e -> Generator.Error e
- | Generator.Value (lt, next_left) ->
+ | Generator.Value (lt, next_left) -> (
let bindings = bindings_of_tuple attrs lt in
- (match drain (right_producer bindings) with
+ match drain (right_producer bindings) with
| Error (GeneratorError e | StorageError e) -> Generator.Error e
- | Ok right_tuples ->
+ | Ok right_tuples -> (
let lv = get_vals attrs lt in
let matches =
List.filter_map
@@ -271,7 +269,7 @@ module Make (Storage : Management.Physical.S) = struct
else None)
right_tuples
in
- (match matches with
+ match matches with
| [] -> from_left next_left (lpos + 1) _pos
| _ ->
chain_with_cont (list_generator matches)
@@ -284,9 +282,9 @@ module Make (Storage : Management.Physical.S) = struct
(of_generator ~name ~schema:merged_schema
?constraints:merged_constraints
(make_right_producer_join_gen left_gen))
- | _ ->
+ | _ -> (
let right_gen = to_generator storage right in
- (match drain right_gen with
+ match drain right_gen with
| Error e -> Error e
| Ok right_tuples ->
let left_gen_result =
@@ -297,9 +295,9 @@ module Make (Storage : Management.Physical.S) = struct
let unique_bindings =
right_tuples
|> List.filter_map (fun rt ->
- let b = bindings_of_tuple attrs rt in
- if List.length b = List.length attrs then Some b
- else None)
+ let b = bindings_of_tuple attrs rt in
+ if List.length b = List.length attrs then Some b
+ else None)
|> List.sort_uniq compare
in
List.fold_left
@@ -308,8 +306,7 @@ module Make (Storage : Management.Physical.S) = struct
match drain (left_producer bindings) with
| Ok new_ts -> Ok (ts @ new_ts)
| Error e -> Error e))
- (Ok [])
- unique_bindings
+ (Ok []) unique_bindings
|> Result.map list_generator
| _ -> Ok (to_generator storage left)
in
diff --git a/lib/catalog.ml b/lib/catalog.ml
index 74fe3de..605c40a 100644
--- a/lib/catalog.ml
+++ b/lib/catalog.ml
@@ -1,9 +1,9 @@
(** Multi-multigroup catalog.
Each multigroup gets its own [Atomic.t], so mutations to independent
- multigroups never contend. The [sakura] multigroup is auto-bootstrapped,
- undeletable, and self-referential: it carries a [public:multigroup]
- relation listing every registered multigroup. *)
+ multigroups never contend. The [sakura] multigroup is auto-bootstrapped,
+ undeletable, and self-referential: it carries a [public:multigroup] relation
+ listing every registered multigroup. *)
type t = {
multigroups : Management.Database.t Atomic.t Utilities.StringMap.t Atomic.t;
@@ -19,8 +19,8 @@ module Make (S : Management.Physical.S with type error = string) = struct
type nonrec t = t
- let map_error r = Result.map_error
- (fun e -> Sexplib.Sexp.to_string (Error.sexp_of_error e)) r
+ let map_error r =
+ Result.map_error (fun e -> Sexplib.Sexp.to_string (Error.sexp_of_error e)) r
let get catalog name =
Utilities.StringMap.find_opt name (Atomic.get catalog.multigroups)
@@ -42,14 +42,15 @@ module Make (S : Management.Physical.S with type error = string) = struct
DB; effective when loading a previously persisted multigroup. *)
let hydrate_prl_libraries storage (db : Management.Database.t) =
match
- Management.Database.get_relation db Prelude.Catalog.loaded_library_rel_name
+ Management.Database.get_relation db
+ Prelude.Catalog.loaded_library_rel_name
with
| None -> ()
- | Some rel ->
+ | Some rel -> (
let hashes =
match rel.Relation.tree with None -> [] | Some t -> Merkle.keys t
in
- (match Manip.load_tuples storage hashes with
+ match Manip.load_tuples storage hashes with
| Error _ -> ()
| Ok tuples ->
List.iter
@@ -69,19 +70,21 @@ module Make (S : Management.Physical.S with type error = string) = struct
with
| Ok (new_db, _) -> new_db
| Error e ->
- Printf.eprintf "Warning: prelude relation %s: %s\n%!"
- rel.name (Sexplib.Sexp.to_string (Error.sexp_of_error e));
+ Printf.eprintf "Warning: prelude relation %s: %s\n%!" rel.name
+ (Sexplib.Sexp.to_string (Error.sexp_of_error e));
db
(** Create DB + seed catalog + fold in [prelude_relations] + hydrate PRL. *)
let bootstrap_multigroup storage ~prelude_relations ~name =
let* db = Manip.create_database storage ~name |> map_error in
- let db = List.fold_left (register_prelude_relation storage) db prelude_relations in
+ let db =
+ List.fold_left (register_prelude_relation storage) db prelude_relations
+ in
hydrate_prl_libraries storage db;
Ok db
- (** Create additional catalog relations beyond the base six.
- Used to seed [public:multigroup] into the sakura multigroup only. *)
+ (** Create additional catalog relations beyond the base six. Used to seed
+ [public:multigroup] into the sakura multigroup only. *)
let seed_extra_catalog storage ~definitions db =
List.fold_left
(fun acc (name, schema) ->
@@ -92,13 +95,14 @@ module Make (S : Management.Physical.S with type error = string) = struct
Ok new_db)
(Ok db) definitions
- (** Write a tuple into sakura's [public:multigroup] and update the ref.
- No-op if the relation doesn't exist yet (bootstrap ordering). *)
+ (** Write a tuple into sakura's [public:multigroup] and update the ref. No-op
+ if the relation doesn't exist yet (bootstrap ordering). *)
let register_in_sakura storage sakura_ref mg_name =
let rec go () =
let sakura = Atomic.get sakura_ref in
match
- Management.Database.get_relation sakura Prelude.Catalog.multigroup_rel_name
+ Management.Database.get_relation sakura
+ Prelude.Catalog.multigroup_rel_name
with
| None -> Ok ()
| Some mg_rel ->
@@ -122,29 +126,39 @@ module Make (S : Management.Physical.S with type error = string) = struct
let sakura_ref = Atomic.make sakura_db in
let* () = register_in_sakura storage sakura_ref sakura_name in
let map = Utilities.StringMap.singleton sakura_name sakura_ref in
- Ok { multigroups = Atomic.make map; default_multigroup = sakura_name; mutex = Mutex.create () }
+ Ok
+ {
+ multigroups = Atomic.make map;
+ default_multigroup = sakura_name;
+ mutex = Mutex.create ();
+ }
let add catalog storage ~prelude_relations name =
Mutex.protect catalog.mutex (fun () ->
- let map = Atomic.get catalog.multigroups in
- if Utilities.StringMap.mem name map then
- Error (Printf.sprintf "Multigroup %s already exists" name)
- else
- let* db = bootstrap_multigroup storage ~prelude_relations ~name in
- let db_ref = Atomic.make db in
- let* () =
- match Utilities.StringMap.find_opt sakura_name map with
- | Some sakura_ref -> register_in_sakura storage sakura_ref name
- | None -> Ok ()
- in
- let new_map = Utilities.StringMap.add name db_ref map in
- let* () = publish_multigroups catalog ~expected:map ~updated:new_map in
- Ok db_ref)
+ let map = Atomic.get catalog.multigroups in
+ if Utilities.StringMap.mem name map then
+ Error (Printf.sprintf "Multigroup %s already exists" name)
+ else
+ let* db = bootstrap_multigroup storage ~prelude_relations ~name in
+ let db_ref = Atomic.make db in
+ let* () =
+ match Utilities.StringMap.find_opt sakura_name map with
+ | Some sakura_ref -> register_in_sakura storage sakura_ref name
+ | None -> Ok ()
+ in
+ let new_map = Utilities.StringMap.add name db_ref map in
+ let* () =
+ publish_multigroups catalog ~expected:map ~updated:new_map
+ in
+ Ok db_ref)
let unregister_from_sakura storage sakura_ref mg_name =
let rec go () =
let sakura = Atomic.get sakura_ref in
- match Management.Database.get_relation sakura Prelude.Catalog.multigroup_rel_name with
+ match
+ Management.Database.get_relation sakura
+ Prelude.Catalog.multigroup_rel_name
+ with
| None -> Ok ()
| Some mg_rel ->
let tuple_hash =
@@ -159,22 +173,22 @@ module Make (S : Management.Physical.S with type error = string) = struct
go ()
let remove catalog storage name =
- if name = sakura_name then
- Error "Cannot remove the sakura system catalog"
+ if name = sakura_name then Error "Cannot remove the sakura system catalog"
else
Mutex.protect catalog.mutex (fun () ->
- let map = Atomic.get catalog.multigroups in
- if not (Utilities.StringMap.mem name map) then
- Error (Printf.sprintf "Multigroup %s does not exist" name)
- else
- let* () =
- match Utilities.StringMap.find_opt sakura_name map with
- | None -> Ok ()
- | Some sakura_ref -> unregister_from_sakura storage sakura_ref name
- in
- let new_map = Utilities.StringMap.remove name map in
- let* () =
- publish_multigroups catalog ~expected:map ~updated:new_map
- in
- Ok ())
+ let map = Atomic.get catalog.multigroups in
+ if not (Utilities.StringMap.mem name map) then
+ Error (Printf.sprintf "Multigroup %s does not exist" name)
+ else
+ let* () =
+ match Utilities.StringMap.find_opt sakura_name map with
+ | None -> Ok ()
+ | Some sakura_ref ->
+ unregister_from_sakura storage sakura_ref name
+ in
+ let new_map = Utilities.StringMap.remove name map in
+ let* () =
+ publish_multigroups catalog ~expected:map ~updated:new_map
+ in
+ Ok ())
end
diff --git a/lib/configuration.ml b/lib/configuration.ml
index 6229ce6..3f66ac0 100644
--- a/lib/configuration.ml
+++ b/lib/configuration.ml
@@ -26,9 +26,11 @@ let insert_section ~expected acc key body =
in
match body with
| [ subtree ] -> Ok (Utilities.StringMap.add key subtree acc)
- | [] -> errorf "Configuration section %s is empty (expected a tagged value)" key
+ | [] ->
+ errorf "Configuration section %s is empty (expected a tagged value)" key
| _ ->
- errorf "Configuration section %s has multiple values (expected exactly one)"
+ errorf
+ "Configuration section %s has multiple values (expected exactly one)"
key
(** [(server ...)] sexp -> section map. Rejects unknown/duplicate keys. *)
diff --git a/lib/conventions.ml b/lib/conventions.ml
index cdc63a9..fe85737 100644
--- a/lib/conventions.ml
+++ b/lib/conventions.ml
@@ -20,8 +20,7 @@ module Cardinality = struct
end
module Purity = struct
- type t = Pure | IO
- [@@deriving sexp]
+ type t = Pure | IO [@@deriving sexp]
end
module AbstractValue = struct
diff --git a/lib/dcl/sublanguage.ml b/lib/dcl/sublanguage.ml
index ecd2e60..34d4c62 100644
--- a/lib/dcl/sublanguage.ml
+++ b/lib/dcl/sublanguage.ml
@@ -17,8 +17,10 @@ module Make (Storage : Management.Physical.S with type error = string) = struct
let execute storage db ast =
match Exec.execute storage db ast with
| Ok (Exec.DbResult (db, _)) -> Ok (Sublanguage_types.Transition db)
- | Ok (Exec.Switch multigroup) -> Ok (Sublanguage_types.SessionSwitch multigroup)
- | Ok (Exec.NewMultigroup name) -> Ok (Sublanguage_types.CreateMultigroup name)
+ | Ok (Exec.Switch multigroup) ->
+ Ok (Sublanguage_types.SessionSwitch multigroup)
+ | Ok (Exec.NewMultigroup name) ->
+ Ok (Sublanguage_types.CreateMultigroup name)
| Error e -> Error e
let sexp_of_error = Exec.sexp_of_error
diff --git a/lib/ddl/executor.ml b/lib/ddl/executor.ml
index 9df878d..2a0c205 100644
--- a/lib/ddl/executor.ml
+++ b/lib/ddl/executor.ml
@@ -9,9 +9,9 @@ module Make (Storage : Management.Physical.S) = struct
let sexp_of_error e =
let open Sexplib.Sexp in
match e with
- | ParseError s -> List [Atom "parse-error"; Atom s]
+ | ParseError s -> List [ Atom "parse-error"; Atom s ]
| ManipulationError e -> Error.sexp_of_error e
- | RelationNotFound s -> List [Atom "relation-not-found"; Atom s]
+ | RelationNotFound s -> List [ Atom "relation-not-found"; Atom s ]
let ( let* ) = Result.bind
let wrap_manip r = Result.map_error (fun e -> ManipulationError e) r
diff --git a/lib/dml/executor.ml b/lib/dml/executor.ml
index e92b0f5..a4b4e21 100644
--- a/lib/dml/executor.ml
+++ b/lib/dml/executor.ml
@@ -12,11 +12,13 @@ module Make (Storage : Management.Physical.S) = struct
let sexp_of_error e =
let open Sexplib.Sexp in
match e with
- | ParseError s -> List [Atom "parse-error"; Atom s]
- | ManipulationError e -> Error.sexp_of_error e
- | RelationNotFound s -> List [Atom "relation-not-found"; Atom s]
- | AlgebraError (Algebra.StorageError s) -> List [Atom "storage-error"; Atom s]
- | AlgebraError (Algebra.GeneratorError s) -> List [Atom "generator-error"; Atom s]
+ | ParseError s -> List [ Atom "parse-error"; Atom s ]
+ | ManipulationError e -> Error.sexp_of_error e
+ | RelationNotFound s -> List [ Atom "relation-not-found"; Atom s ]
+ | AlgebraError (Algebra.StorageError s) ->
+ List [ Atom "storage-error"; Atom s ]
+ | AlgebraError (Algebra.GeneratorError s) ->
+ List [ Atom "generator-error"; Atom s ]
let ( let* ) = Result.bind
let wrap_manip r = Result.map_error (fun e -> ManipulationError e) r
@@ -122,7 +124,9 @@ module Make (Storage : Management.Physical.S) = struct
(fun acc t ->
let* db = acc in
let* rel = get_rel db target in
- let tuple_hash = Hashing.hash_tuple (retarget rel.Relation.name t) in
+ let tuple_hash =
+ Hashing.hash_tuple (retarget rel.Relation.name t)
+ in
let* db, _ =
Ops.retract_tuple storage db rel ~tuple_hash |> wrap_manip
in
diff --git a/lib/drl/executor.ml b/lib/drl/executor.ml
index 3ff4553..1172553 100644
--- a/lib/drl/executor.ml
+++ b/lib/drl/executor.ml
@@ -24,14 +24,15 @@ module Make (Storage : Management.Physical.S) = struct
let common =
List.filter_map
(fun (n, _) ->
- if List.exists (fun (m, _) -> m = n) filter.Relation.schema
- then Some n
+ if List.exists (fun (m, _) -> m = n) filter.Relation.schema then
+ Some n
else None)
source.Relation.schema
in
let source_attrs = List.map fst source.Relation.schema in
- Result.bind (wrap (Alg.equijoin storage common source filter)) (fun joined ->
- wrap (Alg.project storage source_attrs joined))
+ Result.bind
+ (wrap (Alg.equijoin storage common source filter))
+ (fun joined -> wrap (Alg.project storage source_attrs joined))
let rec execute (storage : Storage.t) (db : Management.Database.t)
(q : Ast.query) : (Relation.t, error) Result.t =
@@ -54,26 +55,21 @@ module Make (Storage : Management.Physical.S) = struct
execute storage db q2 >>= fun r2 ->
wrap (Alg.equijoin storage attrs r1 r2)
| Ast.Project (attrs, q) ->
- execute storage db q >>= fun rel ->
- wrap (Alg.project storage attrs rel)
+ execute storage db q >>= fun rel -> wrap (Alg.project storage attrs rel)
| Ast.Rename (renames, q) ->
execute storage db q >>= fun rel ->
wrap (Alg.rename storage renames rel)
| Ast.Cartesian (q1, q2) ->
execute storage db q1 >>= fun r1 ->
- execute storage db q2 >>= fun r2 ->
- wrap (Alg.equijoin storage [] r1 r2)
+ execute storage db q2 >>= fun r2 -> wrap (Alg.equijoin storage [] r1 r2)
| Ast.Union (q1, q2) ->
execute storage db q1 >>= fun r1 ->
- execute storage db q2 >>= fun r2 ->
- wrap (Alg.union storage r1 r2)
+ execute storage db q2 >>= fun r2 -> wrap (Alg.union storage r1 r2)
| Ast.Diff (q1, q2) ->
execute storage db q1 >>= fun r1 ->
- execute storage db q2 >>= fun r2 ->
- wrap (Alg.diff storage r1 r2)
+ execute storage db q2 >>= fun r2 -> wrap (Alg.diff storage r1 r2)
| Ast.Take (n, q) ->
- execute storage db q >>= fun rel ->
- wrap (Alg.take storage n rel)
+ execute storage db q >>= fun rel -> wrap (Alg.take storage n rel)
end
module Memory = Make (Management.Physical.Memory)
diff --git a/lib/envelope.ml b/lib/envelope.ml
index 4b8bc46..1c20c5b 100644
--- a/lib/envelope.ml
+++ b/lib/envelope.ml
@@ -9,9 +9,8 @@ type tagged = { tag : string; payload : Sexplib.Sexp.t }
let parse (input : Sexplib.Sexp.t) : (tagged, Error.t) Result.t =
match input with
| Sexplib.Sexp.List (Sexplib.Sexp.Atom tag :: rest) ->
- let payload = match rest with
- | [single] -> single
- | many -> Sexplib.Sexp.List many
- in
- Ok { tag; payload }
+ let payload =
+ match rest with [ single ] -> single | many -> Sexplib.Sexp.List many
+ in
+ Ok { tag; payload }
| s -> Error (Error.MalformedExpression s)
diff --git a/lib/error.ml b/lib/error.ml
index 09b2e53..cf02845 100644
--- a/lib/error.ml
+++ b/lib/error.ml
@@ -1,4 +1,3 @@
-
(** Error types for manipulation operations *)
type t =
| RelationNotFound of string
@@ -11,26 +10,33 @@ type t =
| MalformedExpression of Sexplib.Sexp.t
(* TODO: think of a better way to manage and serialize sublanguage errors *)
| SublanguageError of Sexplib.Sexp.t
- | Conflict of { old_db : Management.Database.t; new_db : Management.Database.t}
+ | Conflict of {
+ old_db : Management.Database.t;
+ new_db : Management.Database.t;
+ }
| SyntaxError of string
| MultigroupNotFound of string
let sexp_of_error e =
let open Sexplib.Sexp in
let error e ps = List (Atom e :: ps) in
- let (<+>) key value = List [Atom key; value] in
+ let ( <+> ) key value = List [ Atom key; value ] in
match e with
(* TODO: think of a subset of common attributes that every error should have (message, etc)? *)
- | RelationNotFound s -> error "relation-not-found" ["relation" <+> (Atom s)]
- | RelationAlreadyExists s -> error "relation-already-exists" ["relation" <+> (Atom s)]
- | TupleNotFound h -> error "tuple-not-found" ["hash" <+> (Atom h)]
- | DuplicateTuple h -> error "duplicate-tuple" ["hash" <+> (Atom h)]
- | ConstraintViolation s -> error "constraint-violation" ["message" <+> (Atom s)]
- | StorageError s -> error "storage-error" ["message" <+> (Atom s)]
- | UnrecognizedSublanguage s -> error "unrecognized-sublanguage" ["tag" <+> (Atom s)]
- | MalformedExpression s -> error "malformed-expression" ["expression" <+> s]
- | SublanguageError s -> error "sublanguage-error" ["error" <+> s]
- | SyntaxError s -> error "syntax-error" ["message" <+> (Atom s)]
- | MultigroupNotFound s -> error "multigroup-not-found" ["name" <+> (Atom s)]
- | Conflict { old_db; new_db } -> error "conflict" ["old-hash" <+> (Atom old_db.hash);
- "new-hash" <+> (Atom new_db.hash)]
+ | RelationNotFound s -> error "relation-not-found" [ "relation" <+> Atom s ]
+ | RelationAlreadyExists s ->
+ error "relation-already-exists" [ "relation" <+> Atom s ]
+ | TupleNotFound h -> error "tuple-not-found" [ "hash" <+> Atom h ]
+ | DuplicateTuple h -> error "duplicate-tuple" [ "hash" <+> Atom h ]
+ | ConstraintViolation s ->
+ error "constraint-violation" [ "message" <+> Atom s ]
+ | StorageError s -> error "storage-error" [ "message" <+> Atom s ]
+ | UnrecognizedSublanguage s ->
+ error "unrecognized-sublanguage" [ "tag" <+> Atom s ]
+ | MalformedExpression s -> error "malformed-expression" [ "expression" <+> s ]
+ | SublanguageError s -> error "sublanguage-error" [ "error" <+> s ]
+ | SyntaxError s -> error "syntax-error" [ "message" <+> Atom s ]
+ | MultigroupNotFound s -> error "multigroup-not-found" [ "name" <+> Atom s ]
+ | Conflict { old_db; new_db } ->
+ error "conflict"
+ [ "old-hash" <+> Atom old_db.hash; "new-hash" <+> Atom new_db.hash ]
diff --git a/lib/icl/executor.ml b/lib/icl/executor.ml
index 6238906..6f85b60 100644
--- a/lib/icl/executor.ml
+++ b/lib/icl/executor.ml
@@ -9,9 +9,9 @@ module Make (Storage : Management.Physical.S) = struct
let sexp_of_error e =
let open Sexplib.Sexp in
match e with
- | ParseError s -> List [Atom "parse-error"; Atom s]
+ | ParseError s -> List [ Atom "parse-error"; Atom s ]
| ManipulationError e -> Error.sexp_of_error e
- | ConversionError s -> List [Atom "conversion-error"; Atom s]
+ | ConversionError s -> List [ Atom "conversion-error"; Atom s ]
let wrap_manip = Result.map_error (fun e -> ManipulationError e)
diff --git a/lib/listener.ml b/lib/listener.ml
index 9d0e67b..e873b3f 100644
--- a/lib/listener.ml
+++ b/lib/listener.ml
@@ -182,7 +182,10 @@ functor
List
[
Atom "ok";
- List [ Atom "message"; Atom ("Switched to multigroup " ^ multigroup) ];
+ List
+ [
+ Atom "message"; Atom ("Switched to multigroup " ^ multigroup);
+ ];
]
| Ok (Sublanguage.CreateMultigroup name) ->
List
diff --git a/lib/management/branch.ml b/lib/management/branch.ml
index 4485b35..81da225 100644
--- a/lib/management/branch.ml
+++ b/lib/management/branch.ml
@@ -102,8 +102,7 @@ module Make (Storage : Physical.S with type error = string) = struct
~generator:(Some generator)
~membership_criteria:(fun _ _ -> true)
~provenance:(Relation.Provenance.Base Prelude.Catalog.branch_rel_name)
- ~lineage:(Relation.Lineage.Base Prelude.Catalog.branch_rel_name)
- ()
+ ~lineage:(Relation.Lineage.Base Prelude.Catalog.branch_rel_name) ()
let head_relation storage : Relation.t =
let schema = Schema.empty |> Schema.add "branch" "string" in
@@ -130,6 +129,5 @@ module Make (Storage : Physical.S with type error = string) = struct
~generator:(Some generator)
~membership_criteria:(fun _ _ -> true)
~provenance:(Relation.Provenance.Base Prelude.Catalog.head_rel_name)
- ~lineage:(Relation.Lineage.Base Prelude.Catalog.head_rel_name)
- ()
+ ~lineage:(Relation.Lineage.Base Prelude.Catalog.head_rel_name) ()
end
diff --git a/lib/management/merge.ml b/lib/management/merge.ml
index a8860fe..dff4808 100644
--- a/lib/management/merge.ml
+++ b/lib/management/merge.ml
@@ -11,6 +11,7 @@ type strategy = PreferLeft | PreferRight | RevertToAncestor
type merge_result = Clean of Database.t | Failed of conflict list
(* TODO: Remove this later. We already should have the interface on the manipulation *)
+
(** Module type for the subset of Manipulation.Make we need. *)
module type MANIPULATION = sig
type storage
@@ -279,9 +280,9 @@ struct
all_conflicts
in
if unresolvable <> [] then Ok (Failed unresolvable)
- else begin
- match Manip.store_database storage merged_db with
+ else
+ begin match Manip.store_database storage merged_db with
| Error e -> Error e
| Ok () -> Ok (Clean merged_db)
- end)))
+ end)))
end
diff --git a/lib/manipulation.ml b/lib/manipulation.ml
index 31e6079..7ae2753 100644
--- a/lib/manipulation.ml
+++ b/lib/manipulation.ml
@@ -79,7 +79,6 @@ module Make (Storage : Management.Physical.S) = struct
let of_string_error s = Error.StorageError s
let ( let* ) = Result.bind
-
let normalize_name n = Qualified_name.(parse n |> to_key)
let rec normalize_constraint_body c =
@@ -92,7 +91,8 @@ module Make (Storage : Management.Physical.S) = struct
body = normalize_constraint_body body;
universe = normalize_name universe;
}
- | Constraint.And cs -> Constraint.And (List.map normalize_constraint_body cs)
+ | Constraint.And cs ->
+ Constraint.And (List.map normalize_constraint_body cs)
| Constraint.Or cs -> Constraint.Or (List.map normalize_constraint_body cs)
| Constraint.Exists { variable; quantifier; body } ->
Constraint.Exists
@@ -252,8 +252,7 @@ module Make (Storage : Management.Physical.S) = struct
~membership_criteria:
(build_membership_criteria ~name:stored.name stored.schema)
~provenance:(Relation.Provenance.Base stored.name)
- ~lineage:(Relation.Lineage.Base stored.name)
- ()
+ ~lineage:(Relation.Lineage.Base stored.name) ()
in
Ok (Some relation)
@@ -319,8 +318,7 @@ module Make (Storage : Management.Physical.S) = struct
~generator:None
~membership_criteria:(build_membership_criteria ~name schema)
~provenance:(Relation.Provenance.Base name)
- ~lineage:(Relation.Lineage.Base name)
- ()
+ ~lineage:(Relation.Lineage.Base name) ()
in
let new_db = Management.Database.add_relation db ~relation in
let* () = store_relation storage relation in
@@ -846,8 +844,7 @@ module Make (Storage : Management.Physical.S) = struct
~generator:None
~membership_criteria:(build_membership_criteria ~name schema)
~provenance:(Relation.Provenance.Base name)
- ~lineage:(Relation.Lineage.Base name)
- ()
+ ~lineage:(Relation.Lineage.Base name) ()
in
let new_db = Management.Database.add_relation db ~relation in
let* () = store_relation storage relation in
@@ -872,10 +869,9 @@ module Make (Storage : Management.Physical.S) = struct
let relation =
Relation.make ~hash:(Some relation_hash) ~name ~schema
~tree:None (* No tree for generator-based relations *)
- ~constraints:None ~cardinality ~generator:(Some generator)
- ~producer ~membership_criteria ~provenance:(Relation.Provenance.Base name)
- ~lineage:(Relation.Lineage.Base name)
- ()
+ ~constraints:None ~cardinality ~generator:(Some generator) ~producer
+ ~membership_criteria ~provenance:(Relation.Provenance.Base name)
+ ~lineage:(Relation.Lineage.Base name) ()
in
let new_db = Management.Database.add_relation db ~relation in
let* () = store_relation storage relation in
diff --git a/lib/prelude/catalog.ml b/lib/prelude/catalog.ml
index 4b89b4a..c92a89f 100644
--- a/lib/prelude/catalog.ml
+++ b/lib/prelude/catalog.ml
@@ -61,8 +61,7 @@ let multigroup_schema : Schema.t = Schema.empty |> Schema.add "name" "string"
let schema_schema : Schema.t = Schema.empty |> Schema.add "name" "string"
let function_predicate_schema : Schema.t =
- Schema.empty
- |> Schema.add "name" "string"
+ Schema.empty |> Schema.add "name" "string"
|> Schema.add "symbol" "string"
|> Schema.add "cardinality" "string"
|> Schema.add "purity" "string"
@@ -165,8 +164,7 @@ let build_schema_tuple schema_name : Tuple.materialized =
{ Attribute.value = Obj.magic schema_name };
}
-let purity_to_string p =
- Sexplib.Sexp.to_string (Conventions.Purity.sexp_of_t p)
+let purity_to_string p = Sexplib.Sexp.to_string (Conventions.Purity.sexp_of_t p)
let purity_of_string s =
match Conventions.Purity.t_of_sexp (Sexplib.Sexp.of_string s) with
@@ -190,10 +188,10 @@ let build_function_predicate_tuple ~name ~symbol ~cardinality ~purity :
[
("name", { Attribute.value = Obj.magic name });
("symbol", { Attribute.value = Obj.magic symbol });
- ("cardinality",
- { Attribute.value = Obj.magic (cardinality_to_string cardinality) });
- ("purity",
- { Attribute.value = Obj.magic (purity_to_string purity) });
+ ( "cardinality",
+ { Attribute.value = Obj.magic (cardinality_to_string cardinality) }
+ );
+ ("purity", { Attribute.value = Obj.magic (purity_to_string purity) });
];
}
@@ -201,7 +199,5 @@ let build_loaded_library_tuple path : Tuple.materialized =
{
Tuple.relation = loaded_library_rel_name;
attributes =
- Tuple.AttributeMap.singleton "path"
- { Attribute.value = Obj.magic path };
+ Tuple.AttributeMap.singleton "path" { Attribute.value = Obj.magic path };
}
-
diff --git a/lib/prelude/standard.ml b/lib/prelude/standard.ml
index b4f5834..8b0db9f 100644
--- a/lib/prelude/standard.ml
+++ b/lib/prelude/standard.ml
@@ -17,21 +17,20 @@ let make_comparison ~name ~domain_name ~pred ~cardinality ~generator =
in
let membership_criteria : (string -> Merkle.t option) -> Tuple.t -> bool =
fun _tree_of -> function
- | Tuple.Materialized m -> (
- match
- ( Tuple.AttributeMap.find_opt "left" m.attributes,
- Tuple.AttributeMap.find_opt "right" m.attributes )
- with
- | Some l, Some r ->
- pred (Stdlib.compare l.Attribute.value r.Attribute.value)
- | _ -> false)
- | Tuple.NonMaterialized _ -> false
+ | Tuple.Materialized m -> (
+ match
+ ( Tuple.AttributeMap.find_opt "left" m.attributes,
+ Tuple.AttributeMap.find_opt "right" m.attributes )
+ with
+ | Some l, Some r ->
+ pred (Stdlib.compare l.Attribute.value r.Attribute.value)
+ | _ -> false)
+ | Tuple.NonMaterialized _ -> false
in
Relation.make ~hash:None ~name ~schema ~tree:None ~constraints:None
~cardinality ~generator:(Some generator) ~membership_criteria
~provenance:(Relation.Provenance.Base name)
- ~lineage:(Relation.Lineage.Base name)
- ()
+ ~lineage:(Relation.Lineage.Base name) ()
(** Enumerate pairs (a, b) where a < b using triangular indexing. *)
let pair_of_nat_lt n =
@@ -180,25 +179,24 @@ let plus_natural : Relation.t =
in
let membership_criteria : (string -> Merkle.t option) -> Tuple.t -> bool =
fun _tree_of -> function
- | Tuple.Materialized m -> (
- match
- ( Tuple.AttributeMap.find_opt "a" m.attributes,
- Tuple.AttributeMap.find_opt "b" m.attributes,
- Tuple.AttributeMap.find_opt "sum" m.attributes )
- with
- | Some a, Some b, Some s ->
- (Obj.magic a.Attribute.value : int)
- + (Obj.magic b.Attribute.value : int)
- = (Obj.magic s.Attribute.value : int)
- | _ -> false)
- | Tuple.NonMaterialized _ -> false
+ | Tuple.Materialized m -> (
+ match
+ ( Tuple.AttributeMap.find_opt "a" m.attributes,
+ Tuple.AttributeMap.find_opt "b" m.attributes,
+ Tuple.AttributeMap.find_opt "sum" m.attributes )
+ with
+ | Some a, Some b, Some s ->
+ (Obj.magic a.Attribute.value : int)
+ + (Obj.magic b.Attribute.value : int)
+ = (Obj.magic s.Attribute.value : int)
+ | _ -> false)
+ | Tuple.NonMaterialized _ -> false
in
Relation.make ~hash:None ~name:"natural_plus" ~schema ~tree:None
~constraints:None ~cardinality:Conventions.Cardinality.AlephZero
~generator:(Some generator) ~membership_criteria
~provenance:(Relation.Provenance.Base "plus")
- ~lineage:(Relation.Lineage.Base "plus")
- ()
+ ~lineage:(Relation.Lineage.Base "plus") ()
let times_natural : Relation.t =
let schema =
@@ -220,25 +218,24 @@ let times_natural : Relation.t =
in
let membership_criteria : (string -> Merkle.t option) -> Tuple.t -> bool =
fun _tree_of -> function
- | Tuple.Materialized m -> (
- match
- ( Tuple.AttributeMap.find_opt "a" m.attributes,
- Tuple.AttributeMap.find_opt "b" m.attributes,
- Tuple.AttributeMap.find_opt "product" m.attributes )
- with
- | Some a, Some b, Some p ->
- (Obj.magic a.Attribute.value : int)
- * (Obj.magic b.Attribute.value : int)
- = (Obj.magic p.Attribute.value : int)
- | _ -> false)
- | Tuple.NonMaterialized _ -> false
+ | Tuple.Materialized m -> (
+ match
+ ( Tuple.AttributeMap.find_opt "a" m.attributes,
+ Tuple.AttributeMap.find_opt "b" m.attributes,
+ Tuple.AttributeMap.find_opt "product" m.attributes )
+ with
+ | Some a, Some b, Some p ->
+ (Obj.magic a.Attribute.value : int)
+ * (Obj.magic b.Attribute.value : int)
+ = (Obj.magic p.Attribute.value : int)
+ | _ -> false)
+ | Tuple.NonMaterialized _ -> false
in
Relation.make ~hash:None ~name:"natural_times" ~schema ~tree:None
~constraints:None ~cardinality:Conventions.Cardinality.AlephZero
~generator:(Some generator) ~membership_criteria
~provenance:(Relation.Provenance.Base "times")
- ~lineage:(Relation.Lineage.Base "times")
- ()
+ ~lineage:(Relation.Lineage.Base "times") ()
let minus_natural : Relation.t =
let schema =
@@ -261,26 +258,25 @@ let minus_natural : Relation.t =
in
let membership_criteria : (string -> Merkle.t option) -> Tuple.t -> bool =
fun _tree_of -> function
- | Tuple.Materialized m -> (
- match
- ( Tuple.AttributeMap.find_opt "a" m.attributes,
- Tuple.AttributeMap.find_opt "b" m.attributes,
- Tuple.AttributeMap.find_opt "difference" m.attributes )
- with
- | Some a, Some b, Some d ->
- let av = (Obj.magic a.Attribute.value : int) in
- let bv = (Obj.magic b.Attribute.value : int) in
- let dv = (Obj.magic d.Attribute.value : int) in
- av - bv = dv && dv >= 0
- | _ -> false)
- | Tuple.NonMaterialized _ -> false
+ | Tuple.Materialized m -> (
+ match
+ ( Tuple.AttributeMap.find_opt "a" m.attributes,
+ Tuple.AttributeMap.find_opt "b" m.attributes,
+ Tuple.AttributeMap.find_opt "difference" m.attributes )
+ with
+ | Some a, Some b, Some d ->
+ let av = (Obj.magic a.Attribute.value : int) in
+ let bv = (Obj.magic b.Attribute.value : int) in
+ let dv = (Obj.magic d.Attribute.value : int) in
+ av - bv = dv && dv >= 0
+ | _ -> false)
+ | Tuple.NonMaterialized _ -> false
in
Relation.make ~hash:None ~name:"natural_minus" ~schema ~tree:None
~constraints:None ~cardinality:Conventions.Cardinality.AlephZero
~generator:(Some generator) ~membership_criteria
~provenance:(Relation.Provenance.Base "minus")
- ~lineage:(Relation.Lineage.Base "minus")
- ()
+ ~lineage:(Relation.Lineage.Base "minus") ()
let divide_natural : Relation.t =
let schema =
@@ -311,37 +307,38 @@ let divide_natural : Relation.t =
in
let membership_criteria : (string -> Merkle.t option) -> Tuple.t -> bool =
fun _tree_of -> function
- | Tuple.Materialized m -> (
- match
- ( Tuple.AttributeMap.find_opt "a" m.attributes,
- Tuple.AttributeMap.find_opt "b" m.attributes,
- Tuple.AttributeMap.find_opt "quotient" m.attributes,
- Tuple.AttributeMap.find_opt "remainder" m.attributes )
- with
- | Some a, Some b, Some q, Some r ->
- let av = (Obj.magic a.Attribute.value : int) in
- let bv = (Obj.magic b.Attribute.value : int) in
- let qv = (Obj.magic q.Attribute.value : int) in
- let rv = (Obj.magic r.Attribute.value : int) in
- bv > 0 && av = (bv * qv) + rv && rv >= 0 && rv < bv
- | _ -> false)
- | Tuple.NonMaterialized _ -> false
+ | Tuple.Materialized m -> (
+ match
+ ( Tuple.AttributeMap.find_opt "a" m.attributes,
+ Tuple.AttributeMap.find_opt "b" m.attributes,
+ Tuple.AttributeMap.find_opt "quotient" m.attributes,
+ Tuple.AttributeMap.find_opt "remainder" m.attributes )
+ with
+ | Some a, Some b, Some q, Some r ->
+ let av = (Obj.magic a.Attribute.value : int) in
+ let bv = (Obj.magic b.Attribute.value : int) in
+ let qv = (Obj.magic q.Attribute.value : int) in
+ let rv = (Obj.magic r.Attribute.value : int) in
+ bv > 0 && av = (bv * qv) + rv && rv >= 0 && rv < bv
+ | _ -> false)
+ | Tuple.NonMaterialized _ -> false
in
Relation.make ~hash:None ~name:"natural_divide" ~schema ~tree:None
~constraints:None ~cardinality:Conventions.Cardinality.AlephZero
~generator:(Some generator) ~membership_criteria
~provenance:(Relation.Provenance.Base "divide")
- ~lineage:(Relation.Lineage.Base "divide")
- ()
+ ~lineage:(Relation.Lineage.Base "divide") ()
let prelude_relations =
- [ 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 ]
+ [
+ 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;
+ ]
diff --git a/lib/prl/executor.ml b/lib/prl/executor.ml
index d4ceca5..6a53656 100644
--- a/lib/prl/executor.ml
+++ b/lib/prl/executor.ml
@@ -28,15 +28,18 @@ module Make (Storage : Management.Physical.S) = struct
let execute_load_library storage db path =
match Runtime.load_library path with
| Error e -> Error (RuntimeError e)
- | Ok () ->
- let* ll_rel = require_relation db Prelude.Catalog.loaded_library_rel_name in
+ | Ok () -> (
+ let* ll_rel =
+ require_relation db Prelude.Catalog.loaded_library_rel_name
+ in
let tuple = Prelude.Catalog.build_loaded_library_tuple path in
- (match Ops.create_tuple storage db ll_rel tuple with
+ match Ops.create_tuple storage db ll_rel tuple with
| Ok (new_db, _, _) -> Ok (Sublanguage_types.Transition new_db)
| Error (Error.DuplicateTuple _) -> Ok (Sublanguage_types.Transition db)
| Error e -> Error (RelationError e))
- let execute_define_function_predicate storage db (spec : Ast.function_predicate) =
+ let execute_define_function_predicate storage db
+ (spec : Ast.function_predicate) =
match Sakura_prl_api.find spec.symbol with
| None -> Error (UnknownPluginSymbol spec.symbol)
| Some impl ->
@@ -48,7 +51,9 @@ module Make (Storage : Management.Physical.S) = struct
let name = Qualified_name.(parse spec.name |> to_key) in
let generator = Runtime.make_generator name schema impl [] in
let producer = Runtime.make_producer name schema impl in
- let membership_criteria = Runtime.make_membership_criteria schema impl in
+ let membership_criteria =
+ Runtime.make_membership_criteria schema impl
+ in
let* new_db, _ =
Ops.create_immutable_relation storage db ~name ~schema ~generator
~membership_criteria ~cardinality:spec.cardinality
@@ -60,7 +65,8 @@ module Make (Storage : Management.Physical.S) = struct
in
let fp_tuple =
Prelude.Catalog.build_function_predicate_tuple ~name
- ~symbol:spec.symbol ~cardinality:spec.cardinality ~purity:spec.purity
+ ~symbol:spec.symbol ~cardinality:spec.cardinality
+ ~purity:spec.purity
in
let* final_db =
Ops.create_tuple storage new_db fp_rel fp_tuple
diff --git a/lib/prl/runtime.ml b/lib/prl/runtime.ml
index d5e28ec..4b746d4 100644
--- a/lib/prl/runtime.ml
+++ b/lib/prl/runtime.ml
@@ -1,7 +1,4 @@
-type t = {
- loaded_libraries : (string, unit) Hashtbl.t;
- mutex : Mutex.t;
-}
+type t = { loaded_libraries : (string, unit) Hashtbl.t; mutex : Mutex.t }
let state : t =
{ loaded_libraries = Hashtbl.create 16; mutex = Mutex.create () }
@@ -29,16 +26,15 @@ let to_plugin_row (schema : Schema.t) (tuple : Tuple.materialized) :
go [] schema
(* Convert a plugin row back to an engine materialized tuple. *)
-let of_plugin_row relation_name (schema : Schema.t)
- (row : Sakura_prl_api.tuple) : Tuple.materialized option =
+let of_plugin_row relation_name (schema : Schema.t) (row : Sakura_prl_api.tuple)
+ : Tuple.materialized option =
let rec go acc = function
| [] -> Some { Tuple.relation = relation_name; attributes = acc }
| (attr_name, _) :: rest -> (
match List.assoc_opt attr_name row with
| None -> None
| Some value ->
- go (Tuple.AttributeMap.add attr_name { Attribute.value = value } acc)
- rest)
+ go (Tuple.AttributeMap.add attr_name { Attribute.value } acc) rest)
in
go Tuple.AttributeMap.empty schema
@@ -51,7 +47,8 @@ let rows_to_generator relation_name schema (rows : Sakura_prl_api.tuple list) :
if i >= n then Generator.Done
else
match of_plugin_row relation_name schema arr.(i) with
- | None -> Generator.Error "Plugin row does not conform to predicate schema."
+ | None ->
+ Generator.Error "Plugin row does not conform to predicate schema."
| Some tuple -> Generator.Value (Tuple.Materialized tuple, gen (i + 1))
in
gen 0
@@ -60,25 +57,25 @@ let make_generator relation_name schema (impl : Sakura_prl_api.implementation)
(bindings : Sakura_prl_api.tuple) : Generator.t =
match impl.produce with
| None -> fun _ -> Generator.Done
- | Some produce ->
+ | Some produce -> (
let rows_result = lazy (produce bindings) in
fun _pos ->
match Lazy.force rows_result with
| Error e -> Generator.Error e
- | Ok rows -> rows_to_generator relation_name schema rows _pos
+ | Ok rows -> rows_to_generator relation_name schema rows _pos)
let make_producer relation_name schema (impl : Sakura_prl_api.implementation) :
Relation.producer =
- fun bindings -> make_generator relation_name schema impl bindings
+ fun bindings -> make_generator relation_name schema impl bindings
let make_membership_criteria schema (impl : Sakura_prl_api.implementation) :
(string -> Merkle.t option) -> Tuple.t -> bool =
match impl.membership_criteria with
| None -> fun _ _ -> false
- | Some check ->
+ | Some check -> (
fun _tree_of -> function
| Tuple.NonMaterialized _ -> false
| Tuple.Materialized m -> (
match to_plugin_row schema m with
| None -> false
- | Some row -> (match check row with Ok b -> b | Error _ -> false))
+ | Some row -> ( match check row with Ok b -> b | Error _ -> false)))
diff --git a/lib/qualified_name.ml b/lib/qualified_name.ml
index b6d01bb..2155f7d 100644
--- a/lib/qualified_name.ml
+++ b/lib/qualified_name.ml
@@ -6,11 +6,7 @@
- ["mg:schema:relation"] -> { multigroup=mg; schema; relation }
*)
-type t = {
- multigroup : string;
- schema : string;
- relation : string;
-}
+type t = { multigroup : string; schema : string; relation : string }
let default_schema = "public"
diff --git a/lib/qualified_name.mli b/lib/qualified_name.mli
index 9bee0c9..5da7555 100644
--- a/lib/qualified_name.mli
+++ b/lib/qualified_name.mli
@@ -2,23 +2,19 @@
Unqualified names fill in defaults: empty multigroup, ["public"] schema. *)
-type t = {
- multigroup : string;
- schema : string;
- relation : string;
-}
+type t = { multigroup : string; schema : string; relation : string }
val default_schema : string
-(** Split on [:] with default filling.
- - ["rel"] -> multigroup="", schema="public", relation="rel"
- - ["s:rel"] -> multigroup="", schema="s", relation="rel"
- - ["mg:s:rel"] -> multigroup="mg", schema="s", relation="rel" *)
val parse : string -> t
+(** Split on [:] with default filling.
+ - ["rel"] -> multigroup="", schema="public", relation="rel"
+ - ["s:rel"] -> multigroup="", schema="s", relation="rel"
+ - ["mg:s:rel"] -> multigroup="mg", schema="s", relation="rel" *)
val make : ?multigroup:string -> ?schema:string -> string -> t
val to_string : t -> string
+val to_key : t -> string
(** Composite key for [RelationMap] lookup within a single database:
["schema:relation"]. *)
-val to_key : t -> string
diff --git a/lib/relation.ml b/lib/relation.ml
index 6e6a23c..db7f453 100644
--- a/lib/relation.ml
+++ b/lib/relation.ml
@@ -44,7 +44,8 @@ type t = {
lineage : Lineage.t;
}
-let make ?(producer = None) ~hash ~name ~schema ~tree ~constraints ~cardinality ~generator ~membership_criteria ~provenance ~lineage () =
+let make ?(producer = None) ~hash ~name ~schema ~tree ~constraints ~cardinality
+ ~generator ~membership_criteria ~provenance ~lineage () =
{
hash;
name;
diff --git a/lib/session.ml b/lib/session.ml
index a58d00b..a4aef9d 100644
--- a/lib/session.ml
+++ b/lib/session.ml
@@ -54,11 +54,11 @@ let fetch (reg : t) ~(id : string) ~(limit : int) :
abnormally. When fetch gains a richer return type this arm
should surface the error message instead. *)
| Generator.Error _ -> (List.rev acc, gen, pos, false)
- | Generator.Value (t, next) -> begin
- match t with
+ | Generator.Value (t, next) ->
+ begin match t with
| Tuple.Materialized m -> go next (pos + 1) (m :: acc) (count + 1)
| Tuple.NonMaterialized _ -> go next (pos + 1) acc count
- end
+ end
in
let rows, gen', pos', has_more = go cur.generator cur.position [] 0 in
cur.generator <- gen';
diff --git a/lib/system.ml b/lib/system.ml
index 14ef089..40adf82 100644
--- a/lib/system.ml
+++ b/lib/system.ml
@@ -23,21 +23,22 @@ type registry = {
let registry : registry =
let open Utilities.StringMap in
- { storage =
+ {
+ storage =
empty
|> add "memory" (fun sexp ->
- let ( let* ) = Result.bind in
- let* config = Management.Physical.MemoryBackend.parse sexp in
- let* storage = Management.Physical.Memory.create config in
- Ok (StorageParcel ((module Management.Physical.Memory), storage)))
- ; transport =
+ let ( let* ) = Result.bind in
+ let* config = Management.Physical.MemoryBackend.parse sexp in
+ let* storage = Management.Physical.Memory.create config in
+ Ok (StorageParcel ((module Management.Physical.Memory), storage)));
+ transport =
empty
|> add "tcp" (fun sexp ->
- let ( let* ) = Result.bind in
- let* config = Transport.TCP.parse sexp in
- let transport = Transport.TCP.create config in
- Ok (TransportParcel ((module Transport.TCP), transport))) }
-
+ let ( let* ) = Result.bind in
+ let* config = Transport.TCP.parse sexp in
+ let transport = Transport.TCP.create config in
+ Ok (TransportParcel ((module Transport.TCP), transport)));
+ }
let assemble (config : Configuration.t) : (unit -> unit, string) result =
let open Utilities.Result in
@@ -71,8 +72,10 @@ let assemble (config : Configuration.t) : (unit -> unit, string) result =
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 catalog storage)
+ Ok
+ (fun () ->
+ Scl.Executor.set_sessions (Session.create ());
+ L.run transport catalog storage)
let run_from_config (path : string) : (unit -> unit, string) result =
let ( let* ) = Result.bind in
diff --git a/lib/transport.ml b/lib/transport.ml
index 8c8a2bd..b541e16 100644
--- a/lib/transport.ml
+++ b/lib/transport.ml
@@ -22,27 +22,30 @@ module TCP : TRANSPORT = struct
let sockaddr_of_fields = function
| `Inet (addr, port) ->
- Ok { address_family = Unix.PF_INET;
- sockaddr = Unix.ADDR_INET (Unix.inet_addr_of_string addr, port) }
+ Ok
+ {
+ address_family = Unix.PF_INET;
+ sockaddr = Unix.ADDR_INET (Unix.inet_addr_of_string addr, port);
+ }
| `Unix path ->
- Ok { address_family = Unix.PF_UNIX;
- sockaddr = Unix.ADDR_UNIX path }
+ Ok { address_family = Unix.PF_UNIX; sockaddr = Unix.ADDR_UNIX path }
let parse sexp =
let open Sexplib.Sexp in
let errorf fmt = Printf.ksprintf (fun s -> Error s) fmt in
let rec go addr port path = function
- | [] ->
- (match addr, port, path with
- | Some a, Some p, None -> sockaddr_of_fields (`Inet (a, p))
- | None, None, Some s -> sockaddr_of_fields (`Unix s)
- | None, None, None -> errorf "transport/tcp: no address fields"
- | _ -> errorf "transport/tcp: use (address + port) or (path), not both")
+ | [] -> (
+ match (addr, port, path) with
+ | Some a, Some p, None -> sockaddr_of_fields (`Inet (a, p))
+ | None, None, Some s -> sockaddr_of_fields (`Unix s)
+ | None, None, None -> errorf "transport/tcp: no address fields"
+ | _ ->
+ errorf "transport/tcp: use (address + port) or (path), not both")
| List [ Atom "address"; Atom a ] :: rest -> go (Some a) port path rest
- | List [ Atom "port"; Atom p ] :: rest ->
- (match int_of_string_opt p with
- | Some n -> go addr (Some n) path rest
- | None -> errorf "transport/tcp: invalid port: %s" p)
+ | List [ Atom "port"; Atom p ] :: rest -> (
+ match int_of_string_opt p with
+ | Some n -> go addr (Some n) path rest
+ | None -> errorf "transport/tcp: invalid port: %s" p)
| List [ Atom "path"; Atom p ] :: rest -> go addr port (Some p) rest
| bad :: _ -> errorf "transport/tcp: unexpected: %s" (to_string bad)
in
@@ -63,7 +66,8 @@ module TCP : TRANSPORT = struct
let listen fd =
Unix.listen fd 5;
- Printf.printf "Listening on %s\n%!" (string_of_sockaddr (Unix.getsockname fd))
+ Printf.printf "Listening on %s\n%!"
+ (string_of_sockaddr (Unix.getsockname fd))
let accept fd =
let conn, _ = Unix.accept fd in
diff --git a/lib/utilities.ml b/lib/utilities.ml
index d0c5673..34b0eb1 100644
--- a/lib/utilities.ml
+++ b/lib/utilities.ml
@@ -2,9 +2,9 @@ module StringMap = Map.Make (String)
module StringSet = Set.Make (String)
module Result = struct
- let (let*) = Result.bind
+ let ( let* ) = Result.bind
end
module Option = struct
- let (let*) = Option.bind
+ let ( let* ) = Option.bind
end
generated by cgit v1.2.3 (git 2.25.1) at 2026-11-04 03:23:04 +0000