wip ephemeral relations as program consumers

4 files changed, 27 insertions, 189 deletions

diff --git a/lib/kernel/EphemeralRelation.ml b/lib/kernel/EphemeralRelation.ml
index 8aa0463..ddf005d 100644
--- a/lib/kernel/EphemeralRelation.ml
+++ b/lib/kernel/EphemeralRelation.ml
@@ -1,73 +1,29 @@
-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
+type t =
+  { schematics: [`Persisted of Concepts.Hash.hash
+               | `Temporary of (Protocols.Schematics.attribute_description BatMap.String.t) ] }
+
+module Error = struct
+  open Concepts.Condition
+  let local_constraint_not_implemented =
+    condition "local-constraint-not-implemented"
+      "Local constraints have no centralized authority for their discerniment and enforcement yet."
+      empty
+  let predicate_not_implemented =
+    condition "predicate-not-implemented"
+      "Preciate descriptions for relations is not designed yet."
+      empty
 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
+class ephemeral_relation program address value =
+  object (self)
+    inherit Lifecycle.null
+    val relation : t = value
+    method local_constraints = Error Error.local_constraint_not_implemented
+    method predicate = Error Error.predicate_not_implemented
+
+    method protocol : Protocols.Handle.protocol list =
+      Protocols.[ Relation.make self
+                ; Enumerable.make self
+                ; Schematics.make self ]
+    method hash : Concepts.Hash.hash = address
+  end
diff --git a/lib/kernel/SubstantialRelation.ml b/lib/kernel/SubstantialRelation.ml
index f90ddff..242aedb 100644
--- a/lib/kernel/SubstantialRelation.ml
+++ b/lib/kernel/SubstantialRelation.ml
@@ -174,7 +174,6 @@ module Make (S : Abstract.Storage.STORAGE) = struct
       method protocols : Protocols.Handle.protocol list =
         [ Protocols.Relation.make self;
           Protocols.Enumerable.make self;
-          Protocols.Generative.make self;
           Protocols.Schematics.make self ]
 
       method hash = hash relation
diff --git a/lib/protocols/Generative.ml b/lib/protocols/Generative.ml
deleted file mode 100644
index 6846e43..0000000
--- a/lib/protocols/Generative.ml
+++ /dev/null
@@ -1,82 +0,0 @@
-module Error = struct
-  open Concepts.Condition
-
-  let not_generative () =
-    condition "not-generative"
-      "A relation was used where the expression must produce members under a binding, but it \
-       declares no modes. A relation that cannot be asked this way can still be reached through \
-       another access path."
-      empty
-
-  let attributes bound = Concepts.Value.String (String.concat ", " (BatSet.String.elements bound))
-
-  let ungenerable bound =
-    condition "ungenerable-binding"
-      "The relation declares no mode that generates under the attributes bound."
-      ("bound" |=| attributes bound)
-
-  let undecidable bound =
-    condition "undecidable-membership"
-      "The relation declares no mode that decides membership under the attributes of the tuple."
-      ("bound" |=| attributes bound)
-end
-
-type binding = Concepts.Value.value BatMap.String.t
-
-class type implementation = object
-  method modes : (Concepts.Mode.t, Concepts.Condition.condition) result
-  method generate : binding -> (Handle.t, Concepts.Condition.condition) result
-end
-
-type Handle.protocol += Generative of implementation
-type t = implementation
-
-let make impl = Generative (impl :> implementation)
-let from handle = Handle.into handle (function Generative impl -> Some impl | _ -> None)
-let require handle = from handle |> Option.to_result ~none:(Error.not_generative ())
-let nothing = BatMap.String.empty
-let bound = Concepts.Mode.attributes_of_map
-let modes i = Handle.invoke i (fun o -> o#modes)
-
-let generate i binding =
-  Handle.invoke i (fun o ->
-      let open Utilities.Result in
-      let bound = bound binding in
-      let* declaration = o#modes in
-      if Option.is_some (Concepts.Mode.generation declaration bound) then o#generate binding
-      else Error (Error.ungenerable bound) )
-
-let satisfies binding tuple =
-  BatMap.String.for_all
-    (fun attribute value ->
-      match BatMap.String.find_opt attribute tuple.Concepts.Tuple.attributes with
-      | Some found -> Concepts.Value.equal found value
-      | None -> false )
-    binding
-
-class virtual membership =
-  object (self)
-    val virtual heading : Concepts.Mode.attributes
-    method virtual modes : (Concepts.Mode.t, Concepts.Condition.condition) result
-    method virtual generate : binding -> (Handle.t, Concepts.Condition.condition) result
-
-    method contains (tuple : Concepts.Tuple.t) =
-      let open Utilities.Result in
-      let binding = tuple.Concepts.Tuple.attributes in
-      let bound = bound binding in
-      if not (BatSet.String.equal heading bound) then Ok false
-      else
-        let* declaration = self#modes in
-        let* () =
-          if Concepts.Mode.decision declaration bound then Ok ()
-          else Error (Error.undecidable bound)
-        in
-        let* cursor = self#generate binding in
-        let expected = Concepts.Tuple.hash tuple in
-        Fun.protect
-          ~finally:(fun () -> Handle.release cursor)
-          (fun () ->
-            let* scan = Cursor.require cursor in
-            Cursor.exists scan (fun member ->
-                Concepts.Hash.hash_equals (Concepts.Tuple.hash member) expected ) )
-  end
diff --git a/lib/protocols/Generative.mli b/lib/protocols/Generative.mli
deleted file mode 100644
index 5ada329..0000000
--- a/lib/protocols/Generative.mli
+++ /dev/null
@@ -1,35 +0,0 @@
-type t
-
-(** values fixed for some of a relation's attributes, the attributes
-    absent from it being the ones left free. *)
-type binding = Concepts.Value.value BatMap.String.t
-
-class type implementation = object
-  method modes : (Concepts.Mode.t, Concepts.Condition.condition) result
-  method generate : binding -> (Handle.t, Concepts.Condition.condition) result
-end
-
-val make : #implementation -> Handle.protocol
-val from : Handle.t -> t Handle.interface option
-val require : Handle.t -> (t Handle.interface, Concepts.Condition.condition) result
-val modes : t Handle.interface -> (Concepts.Mode.t, Concepts.Condition.condition) result
-
-(** a handle carrying a cursor over the members agreeing with the
-    binding and under the empty binding this is enumeration, so a
-    relation carrying enumerable answers the same members here. Refused
-    when no declared mode generates under the attributes bound. *)
-val generate : t Handle.interface -> binding -> (Handle.t, Concepts.Condition.condition) result
-
-val nothing : binding
-val bound : binding -> Concepts.Mode.attributes
-val satisfies : binding -> Concepts.Tuple.t -> bool
-
-(** membership for a relation with no lookup of its own, asked of the
-    generator under the binding the tuple fixes. Only a tuple carrying
-    exactly the [heading] can be a member, and it must match one whole. *)
-class virtual membership : object
-  val virtual heading : Concepts.Mode.attributes
-  method virtual modes : (Concepts.Mode.t, Concepts.Condition.condition) result
-  method virtual generate : binding -> (Handle.t, Concepts.Condition.condition) result
-  method contains : Concepts.Tuple.t -> (bool, Concepts.Condition.condition) result
-end