From 483089803a411920fea7696ea6b40c664cf3003a Mon Sep 17 00:00:00 2001 From: Marcos Magueta Date: Wed, 7 Oct 2026 23:26:50 -0300 Subject: ephemeral literal, relation heading, subs rel stored & lmdb 1GB map --- lib/backend/storage/LMDB.ml | 6 ++++++ lib/kernel/EphemeralRelation.ml | 32 +++++++++++++++++++++++++------- lib/kernel/SubstantialRelation.ml | 16 ++++++++++++++++ lib/protocols/Relation.ml | 14 ++++++++------ lib/protocols/Relation.mli | 3 +++ 5 files changed, 58 insertions(+), 13 deletions(-) diff --git a/lib/backend/storage/LMDB.ml b/lib/backend/storage/LMDB.ml index 17dda3f..fd6cc8e 100644 --- a/lib/backend/storage/LMDB.ml +++ b/lib/backend/storage/LMDB.ml @@ -43,6 +43,9 @@ module C = struct let mdb_env_close = foreign "mdb_env_close" (ptr mdb_env @-> returning void) + let mdb_env_set_mapsize = + foreign "mdb_env_set_mapsize" (ptr mdb_env @-> size_t @-> returning mdb_result) + let mdb_dbi_open = foreign "mdb_dbi_open" (ptr mdb_txn @-> ptr char @-> uint @-> ptr mdb_dbi @-> returning mdb_result) @@ -139,6 +142,8 @@ type connection = {env: C.mdb_env_ptr; dbi: C.mdb_dbi} type transaction = {tx: C.mdb_txn_ptr; dbi: C.mdb_dbi; mutable active: bool} type address = Label of string | Hash of Concepts.Hash.hash +let mapsize = 1 lsl 30 + let parse (c : Concepts.Configuration.term) = let open Concepts.Configuration in let open Utilities.Result in @@ -166,6 +171,7 @@ let connect (c : Concepts.Configuration.term) = let* () = ensure_directory path (directory_mode mode) in begin let* env = C.mdb_env_create' () in + let* () = C.mdb_env_set_mapsize env (Unsigned.Size_t.of_int mapsize) in (* NOTLS ties readers to transactions rather than threads, so one thread can hold several read transactions (nested cursors). *) match C.mdb_env_open env path C.Flags.mdb_notls (PosixTypes.Mode.of_int mode) with diff --git a/lib/kernel/EphemeralRelation.ml b/lib/kernel/EphemeralRelation.ml index b53256b..ff7bce1 100644 --- a/lib/kernel/EphemeralRelation.ml +++ b/lib/kernel/EphemeralRelation.ml @@ -7,7 +7,16 @@ type t = | `Temporary of Protocols.Schematics.attribute_description BatMap.String.t ]; program: program option } -type Protocols.Handle.protocol += Stored of {evaluator: string; code: Concepts.Blob.t} +(* [name] is the relation a stored program defines, once it is read from + where it was stored under that name. *) +type Protocols.Handle.protocol += + | Stored of {evaluator: string; code: Concepts.Blob.t; name: string option} + +let stored handle = + Protocols.Handle.into handle (function + | Stored {evaluator; code; name} -> Some (evaluator, code, name) + | _ -> None ) + |> Option.map (fun i -> Protocols.Handle.invoke i Fun.id) module Error = struct open Concepts.Condition @@ -92,7 +101,9 @@ class ephemeral_relation ?code description value enumerate inputs = | Some record -> let stored = Option.fold ~none:protocols - ~some:(fun code -> Stored {evaluator= record.program.evaluator; code} :: protocols) + ~some:(fun code -> + Stored {evaluator= record.program.evaluator; code; name= Some record.name} + :: protocols ) code in Protocols.Addressable.make @@ -146,7 +157,9 @@ module Make (S : Abstract.Storage.STORAGE) = struct match bind with | None -> Error (Error.unbound_program name) | Some bind -> - let source = Prototype.mixture [Stored {evaluator= program.evaluator; code}] in + let source = + Prototype.mixture [Stored {evaluator= program.evaluator; code; name= Some name}] + in Result.bind (bind program.evaluator source) enumerate_owned in instantiate ~code description @@ -160,12 +173,17 @@ module Make (S : Abstract.Storage.STORAGE) = struct let* code = SI.get_req tx (S.Hash record.program.code) in Ok (restore ?bind ~code record description) ) + let store tx ~name ~evaluator ~code description = + let open Utilities.Result in + let* schematics = R.store_schema tx description in + let* address = SI.store_blob tx code in + let record = {Persisted.name; schematics; program= {evaluator; code= address}} in + let* _ = SI.store_blob tx (Persisted.Representation.to_blob record) in + Ok record + let persist connection ~name ~evaluator ~code description = SI.with_transaction connection (fun tx -> let open Utilities.Result in - let* schematics = R.store_schema tx description in - let* address = SI.store_blob tx code in - let record = {Persisted.name; schematics; program= {evaluator; code= address}} in - let* _ = SI.store_blob tx (Persisted.Representation.to_blob record) in + let* record = store tx ~name ~evaluator ~code description in Ok (restore ~code record description) ) end diff --git a/lib/kernel/SubstantialRelation.ml b/lib/kernel/SubstantialRelation.ml index 57bb79e..533893c 100644 --- a/lib/kernel/SubstantialRelation.ml +++ b/lib/kernel/SubstantialRelation.ml @@ -134,6 +134,22 @@ module Make (S : Abstract.Storage.STORAGE) = struct |> Result.map (fun description -> new substantial_relation connection relation description |> Protocols.Handle.make ) + let store tx description tuples = + let open Utilities.Result in + let* schematics = store_schema tx description in + let* _ = TupleSet.empty_under tx in + let* node = + TupleSet.with_batch tx (fun () -> + List.fold_left + (fun node tuple -> + let* node = node in + TupleSet.insert tx (Concepts.Tuple.hash tuple) tuple node ) + (Ok TupleSet.empty) tuples ) + in + let relation = {schematics; tuples= TupleSet.hash_of node} in + let* _ = SI.store_blob tx (encode relation) in + Ok relation + let instantiate connection ~schematics = let open Utilities.Result in let* relation = diff --git a/lib/protocols/Relation.ml b/lib/protocols/Relation.ml index b4cc4ec..9a6e739 100644 --- a/lib/protocols/Relation.ml +++ b/lib/protocols/Relation.ml @@ -18,15 +18,17 @@ let from handle = Handle.into handle (function Relation impl -> Some impl | _ -> let require handle = from handle |> Option.to_result ~none:(Error.not_a_relation ()) let contains i tuple = Handle.invoke i (fun o -> o#contains tuple) -let read relation = +let heading relation = let open Utilities.Result in let* schematics = Handle.require Schematics.from relation in let* description = Schematics.describe schematics in - let* heading = - match description with - | Schematics.Relation heading -> Ok heading - | _ -> Error (Error.not_a_relation ()) - in + match description with + | Schematics.Relation heading -> Ok heading + | _ -> Error (Error.not_a_relation ()) + +let read relation = + let open Utilities.Result in + let* heading = heading relation in let* enumerable = Enumerable.require relation in let* cursor = Enumerable.enumerate enumerable in Fun.protect diff --git a/lib/protocols/Relation.mli b/lib/protocols/Relation.mli index 87e6ab2..47d1d3e 100644 --- a/lib/protocols/Relation.mli +++ b/lib/protocols/Relation.mli @@ -9,6 +9,9 @@ val from : Handle.t -> t Handle.interface option val require : Handle.t -> (t Handle.interface, Concepts.Condition.condition) result val contains : t Handle.interface -> Concepts.Tuple.t -> (bool, Concepts.Condition.condition) result +(** the heading a relation describes itself with. *) +val heading : Handle.t -> (Schematics.relation_description, Concepts.Condition.condition) result + (** the heading and tuples of a relation, read whole. *) val read : Handle.t -> -- cgit v1.2.3