Merge branch 'relation-bipartite-registration'

11 files changed, 406 insertions, 31 deletions

diff --git a/lib/concepts/Encoding.ml b/lib/concepts/Encoding.ml
index 733ff67..d78eb28 100644
--- a/lib/concepts/Encoding.ml
+++ b/lib/concepts/Encoding.ml
@@ -235,6 +235,7 @@ module Record = struct
   module type S = sig
     type t
 
+    val tag : char
     val to_bencode : t -> Bencode.t
     val of_bencode : Bencode.t -> (t, Condition.condition) result
     val to_blob : t -> Blob.t
@@ -255,6 +256,7 @@ module Record = struct
   module Make (B : BODY) : S with type t = B.t = struct
     type t = B.t
 
+    let tag = B.tag
     let to_bencode object_ = Bencode.Tagged (B.tag, Bencode.Dict (B.fields object_))
 
     let of_bencode = function
diff --git a/lib/evaluators/FOL.ml b/lib/evaluators/FOL.ml
index 016e3a0..e436eeb 100644
--- a/lib/evaluators/FOL.ml
+++ b/lib/evaluators/FOL.ml
@@ -23,11 +23,90 @@ module Error = struct
   let released_relation name =
     condition "released-relation" "A plan named a relation that was already released"
       ("object" |=| Concepts.Value.String name)
+
+  let malformed_program () =
+    condition "malformed-fol-program"
+      "A stored FOL program did not conform to what was expected. Is your database corrupted?" empty
+
+  let foreign_program evaluator =
+    condition "foreign-program" "A plan named a relation stored by another evaluator"
+      ("evaluator" |=| Concepts.Value.String evaluator)
+
+  let cyclic_program code =
+    condition "cyclic-program" "A stored program reads itself"
+      ("program" |=| Concepts.Value.String (Concepts.Hash.to_hum_string code))
 end
 
-type plan = Base of Protocols.Handle.t | Project of plan * string BatFingerTree.t
+let name = "fol"
+
+type 'r term = Base of 'r | Project of 'r term * string BatFingerTree.t
+type plan = Protocols.Handle.t term
 type Protocols.Handle.protocol += Plan of plan
 
+module Bencode = Concepts.Encoding.Bencode
+
+let rec bencode_of_term =
+  let strings values = Bencode.List (List.map (fun value -> Bencode.String value) values) in
+  function
+  | Base path -> Bencode.Tagged ('b', strings (Kernel.Path.to_list path))
+  | Project (term, attributes) ->
+      Bencode.Tagged
+        ( 'p',
+          Bencode.Dict
+            ["term", bencode_of_term term; "attributes", strings (BatFingerTree.to_list attributes)]
+        )
+
+let rec term_of_bencode =
+  let open Utilities.Result in
+  let strings values =
+    let* values = Bencode.as_list values in
+    List.map Bencode.as_string values |> Utilities.List.sequence
+  in
+  function
+  | Bencode.Tagged ('b', segments) ->
+      strings segments |> Result.map (fun segments -> Base (Kernel.Path.of_list segments))
+  | Bencode.Tagged ('p', data) ->
+      let* term = Bencode.field "term" data |> fmap term_of_bencode in
+      let* attributes = Bencode.field "attributes" data |> fmap strings in
+      Ok (Project (term, BatFingerTree.of_list attributes))
+  | _ -> Error (Error.malformed_program ())
+
+let encode term = bencode_of_term term |> Bencode.to_blob
+let decode code = Bencode.of_blob code |> Utilities.Result.fmap term_of_bencode
+
+let stored relation =
+  Protocols.Handle.into relation (function
+    | Kernel.EphemeralRelation.Stored {evaluator; code} -> Some (evaluator, code)
+    | _ -> None )
+  |> Option.map (fun stored -> Protocols.Handle.invoke stored Fun.id)
+
+(* TODO: To strenghten our checks for self references, we need to
+   construct a graph and see raise a condition if there are self
+   references. We partially do that here with the program calling
+   self, but if the flow is alternated, say between program A and B,
+   where B calls A and A calls B, we also must check. *)
+let instantiate resolve =
+  let open Utilities.Result in
+  let rec bind expanding = function
+    | Base reference -> (
+        let* relation = resolve reference in
+        match stored relation with
+        | None -> Ok (Base relation)
+        | Some (evaluator, code) ->
+            Protocols.Handle.release relation;
+            let identity = Concepts.Hash.hash_of_blob code in
+            if not (String.equal evaluator name) then Error (Error.foreign_program evaluator)
+            else if List.exists (Concepts.Hash.hash_equals identity) expanding then
+              Error (Error.cyclic_program identity)
+            else
+              let* term = decode code in
+              bind (identity :: expanding) term )
+    | Project (term, attributes) ->
+        let* plan = bind expanding term in
+        Ok (Project (plan, attributes))
+  in
+  bind []
+
 class program plan =
   object
     inherit Kernel.Lifecycle.null
@@ -96,7 +175,7 @@ let project description relation =
 
 let derive relation description enumerate =
   Kernel.EphemeralRelation.instantiate ~inputs:[relation] description
-    {Kernel.EphemeralRelation.schematics= `Temporary description}
+    {Kernel.EphemeralRelation.name= None; schematics= `Temporary description; program= None}
     (fun () -> enumerate relation)
 
 let rec execute plan =
diff --git a/lib/kernel/EphemeralRelation.ml b/lib/kernel/EphemeralRelation.ml
index e1e450d..1d9267e 100644
--- a/lib/kernel/EphemeralRelation.ml
+++ b/lib/kernel/EphemeralRelation.ml
@@ -1,13 +1,67 @@
+type program = {evaluator: string; code: Concepts.Hash.hash}
+
 type t =
-  { schematics:
+  { name: string option;
+    schematics:
       [ `Persisted of Concepts.Hash.hash
-      | `Temporary of Protocols.Schematics.attribute_description BatMap.String.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}
 
 module Error = struct
-  (* open Concepts.Condition *)
+  open Concepts.Condition
+
+  let malformed_relation () =
+    condition "malformed-ephemeral-relation"
+      "The on-disk representation of an ephemeral relation did not conform to what was expected. \
+       Is your database corrupted?"
+      empty
+
+  let unbound_program name =
+    condition "unbound-program"
+      "A stored relation has to be instantiated by its evaluator before it can be enumerated"
+      ("relation" |=| Concepts.Value.String name)
 end
 
-class ephemeral_relation description value enumerate inputs =
+module Persisted = struct
+  type nonrec t = {name: string; schematics: Concepts.Hash.hash; program: program}
+
+  module rec Representation : (Concepts.Encoding.Record.S with type t = t) =
+    Concepts.Encoding.Record.Make (Body)
+
+  and Body : Concepts.Encoding.Record.BODY = struct
+    type nonrec t = t
+
+    let tag = 'E'
+    let malformed = Error.malformed_relation
+
+    let fields {name; schematics; program= {evaluator; code}} =
+      let open Concepts.Encoding in
+      [ "name", Field.string name;
+        "schema", Value.bencode_of_hash schematics;
+        "evaluator", Field.string evaluator;
+        "program", Value.bencode_of_hash code ]
+
+    let of_fields fields =
+      let open Utilities.Result in
+      let open Concepts.Encoding in
+      let* name = Field.require_string "name" fields in
+      let* schematics = Bencode.field "schema" fields |> fmap Value.hash_of_bencode in
+      let* evaluator = Field.require_string "evaluator" fields in
+      let* code = Bencode.field "program" fields |> fmap Value.hash_of_bencode in
+      Ok {name; schematics; program= {evaluator; code}}
+  end
+end
+
+(* FIXME: Bring the Persisted/Temporary out to avoid using the
+   wildcard and optionals *)
+let persisted = function
+  | {name= Some name; schematics= `Persisted schematics; program= Some program} ->
+      Some {Persisted.name; schematics; program}
+  | _ -> None
+
+class ephemeral_relation ?code description value enumerate inputs =
   object (self)
     inherit Lifecycle.counted
     inherit Identity.of_id
@@ -17,6 +71,10 @@ class ephemeral_relation description value enumerate inputs =
     method enumerate : (Protocols.Handle.t, Concepts.Condition.condition) result = enumerate ()
     method describe () = Ok (Protocols.Schematics.Relation description)
 
+    (* TODO: We do not need to scan, but simply apply a membership
+       criteria (set of constraints. For now this works, but it's
+       inneficient and hurts data independence, as there is an
+       assymetry between ephemeral and substantial relations. *)
     method contains (tuple : Concepts.Tuple.t) =
       let open Utilities.Result in
       let* cursor = self#enumerate in
@@ -28,8 +86,47 @@ class ephemeral_relation description value enumerate inputs =
               Concepts.Hash.hash_equals (Concepts.Tuple.hash member) (Concepts.Tuple.hash tuple) ) )
 
     method protocols : Protocols.Handle.protocol list =
-      Protocols.[Relation.make self; Enumerable.make self; Schematics.make self]
+      let protocols = Protocols.[Relation.make self; Enumerable.make self; Schematics.make self] in
+      match persisted relation with
+      | None -> protocols
+      | Some record ->
+          let stored =
+            Option.fold ~none:protocols
+              ~some:(fun code -> Stored {evaluator= record.program.evaluator; code} :: protocols)
+              code
+          in
+          Protocols.Addressable.make
+            object
+              method address = Persisted.Representation.to_blob record |> Concepts.Hash.hash_of_blob
+            end
+          :: stored
   end
 
-let instantiate ?(inputs = []) description value enumerate =
-  new ephemeral_relation description value enumerate inputs |> Protocols.Handle.make
+let instantiate ?(inputs = []) ?code description value enumerate =
+  new ephemeral_relation ?code description value enumerate inputs |> Protocols.Handle.make
+
+module Make (S : Abstract.Storage.STORAGE) = struct
+  module SI = Storage.Make (S)
+  module R = SubstantialRelation.Make (S)
+
+  let restore ~code ({Persisted.name; schematics; program} : Persisted.t) description =
+    instantiate ~code description
+      {name= Some name; schematics= `Persisted schematics; program= Some program}
+      (fun () -> Error (Error.unbound_program name))
+
+  let load connection (record : Persisted.t) =
+    SI.with_read connection (fun tx ->
+        let open Utilities.Result in
+        let* description = R.schema_of tx record.schematics in
+        let* code = SI.get_req tx (S.Hash record.program.code) in
+        Ok (restore ~code record description) )
+
+  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
+        Ok (restore ~code record description) )
+end
diff --git a/lib/kernel/Multigroup.ml b/lib/kernel/Multigroup.ml
index 88f5948..1417a65 100644
--- a/lib/kernel/Multigroup.ml
+++ b/lib/kernel/Multigroup.ml
@@ -1,8 +1,35 @@
 module Make (S : Abstract.Storage.STORAGE) = struct
   module SI = Storage.Make (S)
   module R = SubstantialRelation.Make (S)
-  module RelationM = Merkle.Interface (S) (Merkle.StringKey) (R)
-  module RMDirectory = Prototype.Directory.OfTree (S) (Merkle.StringKey) (R)
+  module E = EphemeralRelation.Make (S)
+
+  module Entry = struct
+    module Stored = EphemeralRelation.Persisted.Representation
+
+    type t = Substantial of R.t | Ephemeral of EphemeralRelation.Persisted.t
+
+    let encode = function
+      | Substantial relation -> R.encode relation
+      | Ephemeral relation -> Stored.to_blob relation
+
+    let decode blob =
+      let open Utilities.Result in
+      let open Concepts.Encoding in
+      let* data = Bencode.of_blob blob in
+      match data with
+      | Bencode.Tagged (tag, _) when Char.equal tag Stored.tag ->
+          Stored.of_bencode data |> Result.map (fun relation -> Ephemeral relation)
+      | _ -> R.Representation.of_bencode data |> Result.map (fun relation -> Substantial relation)
+
+    let load storage = function
+      | Substantial relation -> R.load storage relation
+      | Ephemeral relation -> E.load storage relation
+  end
+
+  module RelationM = Merkle.Interface (S) (Merkle.StringKey) (Entry)
+  module RMAddressable = Prototype.Addressable.OfTree (S) (Merkle.StringKey)
+  module RMDirectory = Prototype.Directory.OfTree (S) (Merkle.StringKey) (Entry)
+  module RMAssociative = Prototype.Associative.OfTree (S) (Merkle.StringKey)
 
   type t = {relations: RelationM.address}
 
@@ -52,12 +79,38 @@ module Make (S : Abstract.Storage.STORAGE) = struct
       val storage = conn
       val node = node (* FIXME: see the comment on Branch.ml *)
 
+      (* TODO: Add later to the lifecycle management, accounting for
+         derived instances. Callers must release the previous handle
+         when done with it so its instance can be cleaned up after the
+         last reference is released. *)
+      method deriving multigroup' =
+        let open Utilities.Result in
+        let* node' =
+          SI.with_transaction storage (fun tx ->
+              let* _ = SI.store_blob tx (Representation.to_blob multigroup') in
+              RelationM.find tx multigroup'.relations
+              |> fmap (Option.to_result ~none:(Error.incomplete_multigroup multigroup'.relations)) )
+        in
+        new multigroup storage multigroup' node' |> Protocols.Handle.make |> Result.ok
+
       method protocols : Protocols.Handle.protocol list =
+        let open Utilities.Result in
         Protocols.
           [ Addressable.make self;
+            Prototype.Associative.(
+              of_properties
+                [ ( "relation",
+                    update_only (fun node' ->
+                        Handle.require Addressable.from node'
+                        |> Result.map Addressable.address
+                        |> fmap (fun addr -> self#deriving {relations= addr}) ) ) ] );
             Prototype.Directory.of_properties
               [ ( "relation",
-                  Prototype.mixture [RMDirectory.make ~storage ~node ~constructor:(R.load storage)]
+                  Prototype.mixture_of node (fun make node ->
+                      [ RMAddressable.make ~node:(RelationM.into node);
+                        RMDirectory.make ~storage ~node ~constructor:(Entry.load storage);
+                        RMAssociative.make ~storage ~node:(RelationM.into node)
+                          ~constructor:(fun node' -> RelationM.from node' |> make |> Result.ok ) ] )
                 ) ] ]
 
       method hash = Representation.to_blob multigroup |> Concepts.Hash.hash_of_blob
diff --git a/lib/kernel/Path.ml b/lib/kernel/Path.ml
index 77a6b54..eeef396 100644
--- a/lib/kernel/Path.ml
+++ b/lib/kernel/Path.ml
@@ -2,6 +2,8 @@ type t = string list
 
 let this = []
 let ( @/ ) x y = x :: y
+let of_list segments = segments
+let to_list path = path
 
 let to_string path =
   path
diff --git a/lib/kernel/Path.mli b/lib/kernel/Path.mli
index 198ef83..571e59c 100644
--- a/lib/kernel/Path.mli
+++ b/lib/kernel/Path.mli
@@ -2,6 +2,8 @@ type t
 
 val this : t
 val ( @/ ) : string -> t -> t
+val of_list : string list -> t
+val to_list : t -> string list
 val lookup : Protocols.Handle.t -> t -> (Protocols.Handle.t, Concepts.Condition.condition) result
 
 val update :
diff --git a/lib/kernel/SubstantialRelation.ml b/lib/kernel/SubstantialRelation.ml
index 844b186..57bb79e 100644
--- a/lib/kernel/SubstantialRelation.ml
+++ b/lib/kernel/SubstantialRelation.ml
@@ -74,9 +74,17 @@ module Make (S : Abstract.Storage.STORAGE) = struct
     let* tuples = TupleSet.find tx relation.tuples in
     Option.to_result ~none:(Error.invalid_tuple_root relation.tuples) tuples
 
-  let schema_of tx relation =
+  let store_schema tx description =
+    Concepts.Encoding.Bencode.(
+      Dict
+        ( BatMap.String.bindings description
+        |> List.map (fun (name, {Protocols.Schematics.domain; _}) -> name, String domain) )
+      |> to_blob )
+    |> SI.store_blob tx
+
+  let schema_of tx schematics =
     let open Utilities.Result in
-    let* data = SI.get_req tx (S.Hash relation.schematics) in
+    let* data = SI.get_req tx (S.Hash schematics) in
     let* fields = Concepts.Encoding.Bencode.of_blob data in
     let* kvs = Concepts.Encoding.Bencode.as_dict fields in
     kvs
@@ -112,15 +120,17 @@ module Make (S : Abstract.Storage.STORAGE) = struct
       method enumerate = enumerate connection relation
 
       method protocols : Protocols.Handle.protocol list =
-        [ Protocols.Relation.make self;
+        [ Protocols.Addressable.make self;
+          Protocols.Relation.make self;
           Protocols.Enumerable.make self;
           Protocols.Schematics.make self ]
 
       method hash = encode relation |> Concepts.Hash.hash_of_blob
+      method address = self#hash
     end
 
   let load connection relation =
-    SI.with_read connection (fun tx -> schema_of tx relation)
+    SI.with_read connection (fun tx -> schema_of tx relation.schematics)
     |> Result.map (fun description ->
         new substantial_relation connection relation description |> Protocols.Handle.make )
 
diff --git a/test/Helpers.ml b/test/Helpers.ml
index 7f65007..f812a3a 100644
--- a/test/Helpers.ml
+++ b/test/Helpers.ml
@@ -51,7 +51,9 @@ module Storage = struct
                   SR.TupleSet.insert tx (Concepts.Tuple.hash tuple) tuple node )
                 (Ok SR.TupleSet.empty) tuples
             in
-            Ok {SR.schematics; tuples= SR.TupleSet.hash_of node} )
+            let relation = {SR.schematics; tuples= SR.TupleSet.hash_of node} in
+            let* _ = SI.store_blob tx (SR.encode relation) in
+            Ok relation )
       in
       SR.load conn value
 
diff --git a/test/integration/Registration.ml b/test/integration/Registration.ml
index 60f1690..693435b 100644
--- a/test/integration/Registration.ml
+++ b/test/integration/Registration.ml
@@ -6,12 +6,28 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) =
   module I = Kernel.Initialization.Make (S)
   module B = Kernel.Branch.Make (S)
   module M = Kernel.Multigroup.Make (S)
+  module R = Kernel.SubstantialRelation.Make (S)
+  module E = Kernel.EphemeralRelation.Make (S)
+
+  let book = Kernel.Path.("multigroup" @/ "library" @/ "relation" @/ "book" @/ this)
+  let shelf = Kernel.Path.("multigroup" @/ "library" @/ "relation" @/ "shelf" @/ this)
 
   let run conn =
     let open Utilities.Result in
     begin
       let* root = I.initialize ~evaluators:["fol", Evaluators.FOL.make ()] conn in
       let* multigroup = M.make conn in
+      let* schematics = H.SI.with_transaction conn (fun tx -> H.store_schema tx ["title"]) in
+      let* relation = R.instantiate conn ~schematics in
+      let* multigroup =
+        Kernel.Path.(assoc multigroup ("relation" @/ this) "book" (Some relation))
+      in
+      let* view =
+        E.persist conn ~name:"shelf" ~evaluator:Evaluators.FOL.name
+          ~code:Evaluators.FOL.(encode (Project (Base book, BatFingerTree.singleton "title")))
+          (BatMap.String.singleton "title" {Protocols.Schematics.domain= "string"; provenance= []})
+      in
+      let* multigroup = Kernel.Path.(assoc multigroup ("relation" @/ this) "shelf" (Some view)) in
       let* branch = B.make conn in
       let* branch' =
         Kernel.Path.(assoc branch ("multigroup" @/ this) "library" (Some multigroup))
@@ -20,15 +36,19 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) =
     end
     |> Helpers.condition_as_failure
     |> ignore;
-    begin
-      let* root = I.initialize ~evaluators:["fol", Evaluators.FOL.make ()] conn in
-      let* _ =
-        Kernel.Path.(lookup root ("branch" @/ "master" @/ "multigroup" @/ "library" @/ this))
-      in
-      let* _ = Kernel.Path.(lookup root ("evaluator" @/ "fol" @/ this)) in
-      Ok ()
-    end
-    |> Helpers.condition_as_failure
+    let attributes =
+      begin
+        let* root = I.initialize ~evaluators:["fol", Evaluators.FOL.make ()] conn in
+        let* branch = Kernel.Path.(lookup root ("branch" @/ "master" @/ this)) in
+        let* _ = Kernel.Path.lookup branch book in
+        let* _ = Kernel.Path.(lookup root ("evaluator" @/ "fol" @/ this)) in
+        let* plan = Evaluators.FOL.(instantiate (Kernel.Path.lookup branch) (Base shelf)) in
+        let* description = Evaluators.FOL.describe plan in
+        Ok (BatMap.String.keys description |> BatList.of_enum)
+      end
+      |> Helpers.condition_as_failure
+    in
+    check (list string) "the stored view reads the book it was defined over" ["title"] attributes
 
   let suite =
     ( "registration",
diff --git a/test/unit/evaluators/FOL.ml b/test/unit/evaluators/FOL.ml
index 046fa3f..0a3dabc 100644
--- a/test/unit/evaluators/FOL.ml
+++ b/test/unit/evaluators/FOL.ml
@@ -88,6 +88,92 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) =
       |> List.map (fun tuple -> BatMap.String.bindings tuple.Concepts.Tuple.attributes)
       |> List.sort compare )
 
+  let instantiate_a_program conn =
+    let projected =
+      begin
+        let open Utilities.Result in
+        let* employees = H.relation conn ["name"; "age"] [employee "Alaric" 42] in
+        let root = Kernel.Prototype.(mixture [Directory.of_properties ["employee", employees]]) in
+        let* plan =
+          Rnt.Evaluators.FOL.(
+            instantiate (Kernel.Path.lookup root)
+              (Project (Base Kernel.Path.("employee" @/ this), BatFingerTree.singleton "name")) )
+        in
+        let* evaluator = Protocols.Evaluator.require (Rnt.Evaluators.FOL.make ()) in
+        let* result = Rnt.Evaluators.FOL.program plan |> Protocols.Evaluator.invoke evaluator in
+        drain result
+      end
+      |> Helpers.condition_as_failure
+    in
+    check
+      (list (list (pair string Helpers.value)))
+      "the program ran over the relation its path resolved to"
+      [["name", Concepts.Value.String "Alaric"]]
+      (projected |> List.map (fun tuple -> BatMap.String.bindings tuple.Concepts.Tuple.attributes))
+
+  module E = Kernel.EphemeralRelation.Make (S)
+
+  let store conn term =
+    E.persist conn ~name:"view" ~evaluator:Rnt.Evaluators.FOL.name
+      ~code:(Rnt.Evaluators.FOL.encode term)
+      (BatMap.String.singleton "name" {Protocols.Schematics.domain= "string"; provenance= []})
+
+  let namespace entries =
+    let open Utilities.Result in
+    let root = Kernel.Namespace.make () in
+    let* registry = Protocols.Handle.require Protocols.Registry.from root in
+    let* _ =
+      List.fold_left
+        (fun registered (name, handle) ->
+          let* _ = registered in
+          Protocols.Registry.update registry name None (Some handle) )
+        (Ok true) entries
+    in
+    Ok root
+
+  let expand_a_stored_program conn =
+    let projected =
+      begin
+        let open Utilities.Result in
+        let* employees = H.relation conn ["name"; "age"] [employee "Alaric" 42] in
+        let* view =
+          store conn
+            Rnt.Evaluators.FOL.(
+              Project (Base Kernel.Path.("employee" @/ this), BatFingerTree.singleton "name") )
+        in
+        let* root = namespace ["employee", employees; "view", view] in
+        let* plan =
+          Rnt.Evaluators.FOL.(
+            instantiate (Kernel.Path.lookup root) (Base Kernel.Path.("view" @/ this)) )
+        in
+        let* evaluator = Protocols.Evaluator.require (Rnt.Evaluators.FOL.make ()) in
+        let* result = Rnt.Evaluators.FOL.program plan |> Protocols.Evaluator.invoke evaluator in
+        drain result
+      end
+      |> Helpers.condition_as_failure
+    in
+    check
+      (list (list (pair string Helpers.value)))
+      "the stored program ran in place of its name"
+      [["name", Concepts.Value.String "Alaric"]]
+      (projected |> List.map (fun tuple -> BatMap.String.bindings tuple.Concepts.Tuple.attributes))
+
+  let refuse_a_program_that_reads_itself conn =
+    let expanded =
+      begin
+        let open Utilities.Result in
+        let* view = store conn Rnt.Evaluators.FOL.(Base Kernel.Path.("view" @/ this)) in
+        let* root = namespace ["view", view] in
+        Rnt.Evaluators.FOL.(
+          instantiate (Kernel.Path.lookup root) (Base Kernel.Path.("view" @/ this)) )
+      end
+    in
+    check bool "the expansion stopped at the cycle" true
+      ( match expanded with
+      | Error condition ->
+          BatString.starts_with (Concepts.Condition.to_string_hum condition) "cyclic-program"
+      | Ok _ -> false )
+
   let pull_one_tuple_at_a_time () =
     let produced = ref 0 and closed = ref false in
     let description =
@@ -102,7 +188,7 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) =
     in
     let source =
       Kernel.EphemeralRelation.instantiate description
-        {Kernel.EphemeralRelation.schematics= `Temporary description}
+        {Kernel.EphemeralRelation.name= None; schematics= `Temporary description; program= None}
         (fun () -> Ok (Kernel.Generator.cursor_of ~finally:(fun () -> closed := true) (count 0)))
     in
     let first =
@@ -130,6 +216,12 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) =
       [ test_case "scan-a-base-relation" `Quick (H.with_connection scan_a_base_relation "fol-test");
         test_case "project-away-an-attribute" `Quick
           (H.with_connection project_away_an_attribute "fol-test");
+        test_case "instantiate-a-program" `Quick
+          (H.with_connection instantiate_a_program "fol-test");
+        test_case "expand-a-stored-program" `Quick
+          (H.with_connection expand_a_stored_program "fol-test");
+        test_case "refuse-a-program-that-reads-itself" `Quick
+          (H.with_connection refuse_a_program_that_reads_itself "fol-test");
         test_case "pull-one-tuple-at-a-time" `Quick pull_one_tuple_at_a_time ] )
 end
 
diff --git a/test/unit/kernel/EphemeralRelation.ml b/test/unit/kernel/EphemeralRelation.ml
index 95ce56d..7f113ef 100644
--- a/test/unit/kernel/EphemeralRelation.ml
+++ b/test/unit/kernel/EphemeralRelation.ml
@@ -12,10 +12,11 @@ let description =
     { Protocols.Schematics.domain= "integer";
       provenance= [{Protocols.Schematics.source= ["example"]; attribute= "value"}] }
 
-let over ?inputs members =
-  Ephemeral.instantiate ?inputs description
-    {Ephemeral.schematics= `Temporary description}
-    (fun () -> Ok (Rnt.Kernel.Generator.cursor_of (fun ~yield -> List.iter yield members; Ok ())))
+let temporary = {Ephemeral.name= None; schematics= `Temporary description; program= None}
+
+let over ?inputs ?(value = temporary) members =
+  Ephemeral.instantiate ?inputs description value (fun () ->
+      Ok (Rnt.Kernel.Generator.cursor_of (fun ~yield -> List.iter yield members; Ok ())) )
 
 let values tuples =
   BatFingerTree.to_list tuples
@@ -78,6 +79,20 @@ let describes_itself () =
                 ^ origin.Protocols.Schematics.attribute ) ) )
   | _ -> fail "an ephemeral relation describes itself as a relation"
 
+let addressed_once_persisted () =
+  let persisted code =
+    { Ephemeral.name= Some "example";
+      schematics= `Persisted (Concepts.Hash.hash_of_int 1);
+      program= Some {Ephemeral.evaluator= "fol"; code= Concepts.Hash.hash_of_int code} }
+  in
+  let address value =
+    Protocols.Addressable.from (over ~value []) |> Option.map Protocols.Addressable.address
+  in
+  check bool "a temporary relation has no address" true (Option.is_none (address temporary));
+  check bool "a persisted one has" true (Option.is_some (address (persisted 2)));
+  check bool "and its program is part of it" false
+    (Option.equal Concepts.Hash.hash_equals (address (persisted 2)) (address (persisted 3)))
+
 let releasing_releases_its_inputs () =
   let released = ref false in
   let input =
@@ -99,4 +114,5 @@ let suites () =
       [ test_case "enumerates-every-member" `Quick enumerates_every_member;
         test_case "decides-membership" `Quick decides_membership;
         test_case "describes-itself" `Quick describes_itself;
+        test_case "addressed-once-persisted" `Quick addressed_once_persisted;
         test_case "releasing-releases-its-inputs" `Quick releasing_releases_its_inputs ] ) ]