2 files changed, 109 insertions, 0 deletions
diff --git a/lib/kernel/EphemeralRelation.ml b/lib/kernel/EphemeralRelation.ml
new file mode 100644
index 0000000..b403e13
--- /dev/null
+++ b/lib/kernel/EphemeralRelation.ml
@@ -0,0 +1,73 @@
+module type DERIVATION = sig
+  type plan
+
+  val identity : plan -> Concepts.Hash.hash
+
+  val describe :
+    plan -> (Protocols.Schematics.relation_description, Concepts.Condition.condition) result
+
+  val modes : plan -> (Concepts.Mode.t, Concepts.Condition.condition) result
+
+  val generate :
+    plan ->
+    Protocols.Generative.binding ->
+    (Protocols.Handle.t, Concepts.Condition.condition) result
+end
+
+module Make (D : DERIVATION) = struct
+  let pinned_tag = "rnt/pinned/1"
+
+  let identity ?pinned plan =
+    let derivation = D.identity plan in
+    match pinned with
+    | None -> derivation
+    | Some branch ->
+        pinned_tag ^ Concepts.Hash.to_raw_string derivation ^ Concepts.Hash.to_raw_string branch
+        |> Bytes.of_string
+        |> Concepts.Hash.hash_of_bytes
+
+  class ephemeral (plan : D.plan) address declaration description edges =
+    object (self)
+      inherit Lifecycle.counted
+      inherit Protocols.Generative.membership
+      val heading = Concepts.Mode.attributes_of_map description
+      method destroy = List.iter Protocols.Handle.release edges
+      method predicate = Ok None
+      method local_constraints = Ok None
+      method modes = Ok declaration
+
+      (* A cursor holds a reference to its relation, so the edges it reads
+         outlive a release of the relation that produced it. *)
+      method generate binding =
+        D.generate plan binding
+        |> Result.map (fun cursor ->
+               new Lifecycle.retaining cursor (self :> Lifecycle.lifecycle) |> Protocols.Handle.make )
+
+      method enumerate = self#generate Protocols.Generative.nothing
+      method describe () = Ok (Protocols.Schematics.Relation description)
+
+      method protocols : Protocols.Handle.protocol list =
+        let carried =
+          [ Protocols.Relation.make self;
+            Protocols.Schematics.make self;
+            Protocols.Generative.make self ]
+        in
+        if Concepts.Mode.exhaustible declaration BatSet.String.empty then
+          Protocols.Enumerable.make self :: carried
+        else carried
+
+      method hash : Concepts.Hash.hash = address
+    end
+
+  let derive ?pinned ?(edges = []) plan =
+    let open Utilities.Result in
+    let derived =
+      let* declaration = D.modes plan in
+      let* description = D.describe plan in
+      Ok
+        ( new ephemeral plan (identity ?pinned plan) declaration description edges
+        |> Protocols.Handle.make )
+    in
+    Result.iter_error (fun _ -> List.iter Protocols.Handle.release edges) derived;
+    derived
+end
diff --git a/lib/kernel/EphemeralRelation.mli b/lib/kernel/EphemeralRelation.mli
new file mode 100644
index 0000000..d082394
--- /dev/null
+++ b/lib/kernel/EphemeralRelation.mli
@@ -0,0 +1,36 @@
+module type DERIVATION = sig
+  type plan
+
+  (** the hash of the plan, taken over the branch-local names of its
+      inputs rather than over their content addresses. The idea is to
+      have the same expression denote one object on every branch and
+      at every point in time. *)
+  val identity : plan -> Concepts.Hash.hash
+
+  val describe :
+    plan -> (Protocols.Schematics.relation_description, Concepts.Condition.condition) result
+
+  val modes : plan -> (Concepts.Mode.t, Concepts.Condition.condition) result
+
+  val generate :
+    plan ->
+    Protocols.Generative.binding ->
+    (Protocols.Handle.t, Concepts.Condition.condition) result
+end
+
+module Make (D : DERIVATION) : sig
+  (** unpinned, the identity of the derivation itself; pinned to a
+      branch commit, the identity of that derivation against one
+      reconstructible state, which is the only form for which equal
+      identity implies equal extension. *)
+  val identity : ?pinned:Concepts.Hash.hash -> D.plan -> Concepts.Hash.hash
+
+  (** edges are the handles the derivation reads, which are released
+      when the relation is also. Rejection of a derivation surfaces
+      here instead of when a cursor is being drained. *)
+  val derive :
+    ?pinned:Concepts.Hash.hash ->
+    ?edges:Protocols.Handle.t list ->
+    D.plan ->
+    (Protocols.Handle.t, Concepts.Condition.condition) result
+end