ephemeral literal, relation heading, subs rel stored & lmdb 1GB map

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 ->