format and where claude on fol

14 files changed, 272 insertions, 38 deletions

diff --git a/lib/Utilities.ml b/lib/Utilities.ml
index 0472038..939556e 100644
--- a/lib/Utilities.ml
+++ b/lib/Utilities.ml
@@ -90,11 +90,10 @@ module FingerTree = struct
   let filter_map f =
     BatFingerTree.fold_left
       (fun acc elem ->
-        match f elem with None -> acc | Some result -> BatFingerTree.snoc acc result)
+        match f elem with None -> acc | Some result -> BatFingerTree.snoc acc result )
       BatFingerTree.empty
 
   let concat xss = BatFingerTree.fold_left BatFingerTree.append BatFingerTree.empty xss
-
   let concat_mapm f xs = BatFingerTree.map f xs |> sequence |> Stdlib.Result.map concat
 end
 
diff --git a/lib/Utilities.mli b/lib/Utilities.mli
index e748693..75257af 100644
--- a/lib/Utilities.mli
+++ b/lib/Utilities.mli
@@ -37,7 +37,9 @@ module FingerTree : sig
   val join : string BatFingerTree.t -> string -> string
   val filter_map : ('a -> 'b option) -> 'a BatFingerTree.t -> 'b BatFingerTree.t
   val concat : 'a BatFingerTree.t BatFingerTree.t -> 'a BatFingerTree.t
-  val concat_mapm : ('a -> ('b BatFingerTree.t, 'e) result) -> 'a BatFingerTree.t -> ('b BatFingerTree.t, 'e) result
+
+  val concat_mapm :
+    ('a -> ('b BatFingerTree.t, 'e) result) -> 'a BatFingerTree.t -> ('b BatFingerTree.t, 'e) result
 end
 
 module Fun : sig
diff --git a/lib/concepts/Mode.ml b/lib/concepts/Mode.ml
index 82c207f..b3031fc 100644
--- a/lib/concepts/Mode.ml
+++ b/lib/concepts/Mode.ml
@@ -16,3 +16,6 @@ let exhaustible modes bound =
   Option.fold ~none:false ~some:Cardinality.exhaustible (generation modes bound)
 
 let project attributes = List.filter (fun {bound; _} -> BatSet.String.subset bound attributes)
+
+let given attributes =
+  List.map (fun {bound; yields} -> {bound= BatSet.String.diff bound attributes; yields})
diff --git a/lib/concepts/Mode.mli b/lib/concepts/Mode.mli
index d91b2ab..ba1a04a 100644
--- a/lib/concepts/Mode.mli
+++ b/lib/concepts/Mode.mli
@@ -12,3 +12,5 @@ val exhaustible : t -> attributes -> bool
 
 (** the modes still usable when only [attributes] can be bound. *)
 val project : attributes -> t -> t
+
+val given : attributes -> t -> t
diff --git a/lib/evaluators/FOL.ml b/lib/evaluators/FOL.ml
index f337d61..1064c74 100644
--- a/lib/evaluators/FOL.ml
+++ b/lib/evaluators/FOL.ml
@@ -12,7 +12,7 @@ module Error = struct
     condition "not-a-fol-program" "The evaluator was given a program of another kind" empty
 
   let unknown_attribute name =
-    condition "unknown-attribute" "A plan projected an attribute its relation does not have"
+    condition "unknown-attribute" "A plan named an attribute its relation does not have"
       ("attribute" |=| Concepts.Value.String name)
 
   let malformed_program () =
@@ -26,7 +26,13 @@ end
 
 let name = "fol"
 
-type 'r term = Base of 'r | Project of 'r term * string BatFingerTree.t
+type binding = Concepts.Value.value BatMap.String.t
+
+type 'r term =
+  | Base of 'r
+  | Project of 'r term * string BatFingerTree.t
+  | Where of 'r term * binding
+
 type plan = Protocols.Handle.t term
 type Kernel.Program.kind += Fol of Kernel.Path.t term
 
@@ -42,6 +48,16 @@ let rec bencode_of_term =
           Bencode.Dict
             ["term", bencode_of_term term; "attributes", strings (BatFingerTree.to_list attributes)]
         )
+  | Where (term, binding) ->
+      Bencode.Tagged
+        ( 'w',
+          Bencode.Dict
+            [ "term", bencode_of_term term;
+              ( "binding",
+                Bencode.Dict
+                  ( BatMap.String.bindings binding
+                  |> List.map (fun (name, value) -> name, Concepts.Tuple.bencode_of_value value) ) )
+            ] )
 
 let rec term_of_bencode =
   let open Utilities.Result in
@@ -56,10 +72,32 @@ let rec term_of_bencode =
       let* term = Bencode.field "term" data |>> term_of_bencode in
       let* attributes = Bencode.field "attributes" data |>> strings in
       Ok (Project (term, BatFingerTree.of_list attributes))
+  | Bencode.Tagged ('w', data) ->
+      let* term = Bencode.field "term" data |>> term_of_bencode in
+      let* binding = Bencode.field "binding" data |>> Bencode.as_dict in
+      let* binding =
+        List.map
+          (fun (name, value) ->
+            Concepts.Tuple.value_of_bencode value |> Result.map (fun value -> name, value) )
+          binding
+        |> Utilities.List.sequence
+      in
+      Ok (Where (term, BatMap.String.of_list binding))
   | _ -> Error (Error.malformed_program ())
 
 let encode term = bencode_of_term term |> Bencode.to_bytes |> Bytes.to_string
 let decode source = Utilities.Result.(Bencode.of_bytes (Bytes.of_string source) |>> term_of_bencode)
+let bound binding = BatSet.String.of_enum (BatMap.String.keys binding)
+let names attributes = BatSet.String.of_list (BatFingerTree.to_list attributes)
+
+let rec push = function
+  | Base relation -> Base relation
+  | Project (term, attributes) -> Project (push term, attributes)
+  | Where (term, binding) -> (
+    match push term with
+    | Project (term, attributes) when BatSet.String.subset (bound binding) (names attributes) ->
+        Project (push (Where (term, binding)), attributes)
+    | term -> Where (term, binding) )
 
 (* TODO: To strenghten our checks for self references, we need to
    construct a graph and see raise a condition if there are self
@@ -87,8 +125,11 @@ let instantiate within =
     | Project (term, attributes) ->
         let* plan = bind expanding term in
         Ok (Project (plan, attributes))
+    | Where (term, binding) ->
+        let* plan = bind expanding term in
+        Ok (Where (plan, binding))
   in
-  bind []
+  fun term -> bind [] term |> Result.map push
 
 let restrict attributes description =
   let open Utilities.Result in
@@ -106,6 +147,18 @@ let rec describe =
   function
   | Base relation -> Protocols.Relation.heading relation
   | Project (plan, attributes) -> describe plan |>> restrict attributes
+  | Where (plan, binding) ->
+      let* heading = describe plan in
+      let* _ = restrict (BatFingerTree.of_enum (BatMap.String.keys binding)) heading in
+      Ok heading
+
+let index_for relation binding =
+  let open Utilities.Option in
+  let* indexed = Protocols.Indexed.from relation in
+  let* attribute =
+    List.find_opt (fun a -> BatMap.String.mem a binding) (Protocols.Indexed.indexes indexed)
+  in
+  Some (indexed, attribute)
 
 let rec modes =
   let open Utilities.Result in
@@ -114,9 +167,13 @@ let rec modes =
       let* relation = Protocols.Relation.require relation in
       Protocols.Relation.modes relation
   | Project (plan, attributes) ->
-      modes plan
-      |> Result.map
-           (Concepts.Mode.project (BatSet.String.of_list (BatFingerTree.to_list attributes)))
+      modes plan |> Result.map (Concepts.Mode.project (names attributes))
+  | Where (plan, binding) -> (
+      let* modes = modes plan in
+      match plan with
+      | Base relation when Option.is_some (index_for relation binding) ->
+          Ok (Concepts.Mode.given (bound binding) modes)
+      | _ -> Ok modes )
 
 let project description relation =
   let open Utilities.Result in
@@ -146,6 +203,23 @@ let project description relation =
   in
   Ok (Kernel.Generator.cursor_of ~finally:(fun () -> Protocols.Handle.release cursor) produce)
 
+let agrees binding {Concepts.Tuple.attributes; _} =
+  BatMap.String.for_all
+    (fun name value ->
+      Option.fold ~none:false ~some:(Concepts.Value.equal value)
+        (BatMap.String.find_opt name attributes) )
+    binding
+
+let restricted binding relation =
+  let open Utilities.Result in
+  let* cursor =
+    match index_for relation binding with
+    | Some (indexed, attribute) ->
+        Protocols.Indexed.lookup indexed attribute (BatMap.String.find attribute binding)
+    | None -> Protocols.Enumerable.cursor relation
+  in
+  Ok (Kernel.Generator.filter (agrees binding) cursor)
+
 let contains relation tuple =
   Result.bind (Protocols.Relation.require relation) (fun r -> Protocols.Relation.contains r tuple)
 
@@ -167,6 +241,16 @@ let rec execute plan =
   | Project (plan, _) ->
       let* relation = execute plan in
       Ok (derive relation description modes (project description))
+  | Where (plan, binding) ->
+      let* relation =
+        match plan with
+        | Base relation -> Ok (Protocols.Handle.move relation)
+        | plan -> execute plan
+      in
+      Ok
+        (derive
+           ~decide:(fun tuple -> if agrees binding tuple then contains relation tuple else Ok false)
+           relation description modes (restricted binding) )
 
 class evaluator =
   object (self)
diff --git a/lib/kernel/Branch.ml b/lib/kernel/Branch.ml
index 6f851ed..060efae 100644
--- a/lib/kernel/Branch.ml
+++ b/lib/kernel/Branch.ml
@@ -133,7 +133,8 @@ module Make (S : Abstract.Storage.STORAGE) = struct
               object
                 method check =
                   let* named = Directory.children multigroups in
-                  Utilities.List.concat_mapm admits (BatFingerTree.to_list named) (* FIXME: use finger trees *)
+                  Utilities.List.concat_mapm admits (BatFingerTree.to_list named)
+                (* FIXME: use finger trees *)
               end;
             Prototype.Associative.(
               of_properties
diff --git a/lib/kernel/Generator.ml b/lib/kernel/Generator.ml
index b83de3b..a037b3d 100644
--- a/lib/kernel/Generator.ml
+++ b/lib/kernel/Generator.ml
@@ -53,3 +53,19 @@ class producer_cursor produce finally =
   end
 
 let cursor_of ?finally produce = new producer_cursor produce finally |> Protocols.Handle.make
+
+let filter keep cursor =
+  cursor_of
+    ~finally:(fun () -> Protocols.Handle.release cursor)
+    (fun ~yield ->
+      let open Utilities.Result in
+      let* scan = Protocols.Cursor.require cursor in
+      let rec pass () =
+        let* next = Protocols.Cursor.next scan in
+        match next with
+        | None -> Ok ()
+        | Some tuple ->
+            if keep tuple then yield tuple;
+            pass ()
+      in
+      pass () )
diff --git a/lib/kernel/Merkle.ml b/lib/kernel/Merkle.ml
index 4882ec4..b8599d5 100644
--- a/lib/kernel/Merkle.ml
+++ b/lib/kernel/Merkle.ml
@@ -30,7 +30,10 @@ module type TREE = functor (S : Abstract.Storage.STORAGE) (K : KEY) -> sig
     S.transaction -> K.t -> address -> node -> (node, Concepts.Condition.condition) result
 
   val of_list : S.transaction -> (K.t * address) list -> (node, Concepts.Condition.condition) result
-  val of_finger_tree : S.transaction -> (K.t * address) BatFingerTree.t -> (node, Concepts.Condition.condition) result
+
+  val of_finger_tree :
+    S.transaction -> (K.t * address) BatFingerTree.t -> (node, Concepts.Condition.condition) result
+
   val remove : S.transaction -> K.t -> node -> (node, Concepts.Condition.condition) result
   val lookup : S.transaction -> K.t -> node -> (address option, Concepts.Condition.condition) result
 
diff --git a/lib/kernel/Multigroup.ml b/lib/kernel/Multigroup.ml
index f28abc4..84ef3f8 100644
--- a/lib/kernel/Multigroup.ml
+++ b/lib/kernel/Multigroup.ml
@@ -112,7 +112,9 @@ module Make (S : Abstract.Storage.STORAGE) = struct
     let open Utilities.Result in
     let* listing = Protocols.Handle.require Protocols.Directory.from h in
     let* found = Protocols.Directory.find listing property in
-    let* children = Option.fold ~none:(Ok BatFingerTree.empty) ~some:Protocols.Directory.children found in
+    let* children =
+      Option.fold ~none:(Ok BatFingerTree.empty) ~some:Protocols.Directory.children found
+    in
     BatFingerTree.map
       (fun (name, child) ->
         Prototype.Associative.admission admit name child |> Result.map (fun p -> name, p) )
@@ -121,7 +123,9 @@ module Make (S : Abstract.Storage.STORAGE) = struct
 
   let tree_of tx admissions =
     let open Utilities.Result in
-    BatFingerTree.map (fun (name, store) -> store tx |> Result.map (fun addr -> name, addr)) admissions
+    BatFingerTree.map
+      (fun (name, store) -> store tx |> Result.map (fun addr -> name, addr))
+      admissions
     |> Utilities.FingerTree.sequence
     |>> T.of_finger_tree tx
 
@@ -227,7 +231,8 @@ module Make (S : Abstract.Storage.STORAGE) = struct
       method check =
         let open Utilities.Result in
         let* named = Protocols.Directory.children (relations ?bind storage denial_tree) in
-        let named = BatFingerTree.to_list named in (* FIXME *)
+        let named = BatFingerTree.to_list named in
+        (* FIXME *)
         Utilities.List.concat_mapm (held ?bind) named
 
       method protocols : Protocols.Handle.protocol list =
diff --git a/lib/kernel/Scope.ml b/lib/kernel/Scope.ml
index ba9c1e0..817da97 100644
--- a/lib/kernel/Scope.ml
+++ b/lib/kernel/Scope.ml
@@ -44,7 +44,9 @@ let attribute home relation text =
 (* every relation of a branch state, as multigroup:schema:relation *)
 let catalog_of branch =
   let open Utilities.Result in
-  let name prefix last = Utilities.FingerTree.join (BatFingerTree.reverse (BatFingerTree.cons prefix last)) ":" in
+  let name prefix last =
+    Utilities.FingerTree.join (BatFingerTree.reverse (BatFingerTree.cons prefix last)) ":"
+  in
   let rec down prefix handle properties =
     let* level = Path.find handle Path.(List.hd properties @/ this) in
     match level, List.tl properties with
@@ -55,7 +57,9 @@ let catalog_of branch =
         Ok (BatFingerTree.map (name prefix) names)
     | Some level, rest ->
         let* named = Protocols.Directory.children level in
-        Utilities.FingerTree.concat_mapm (fun (n, child) -> down (BatFingerTree.cons prefix n) child rest) named
+        Utilities.FingerTree.concat_mapm
+          (fun (n, child) -> down (BatFingerTree.cons prefix n) child rest)
+          named
   in
   down BatFingerTree.empty branch ["multigroup"; "schema"; "relation"]
 
@@ -88,7 +92,9 @@ let rec make branch home =
             let* previous = Path.find branch Path.("previous" @/ this) in
             Ok (Option.map (fun p -> make p home) previous)
 
-          method catalog = catalog_of branch |> Result.map BatFingerTree.to_list (* FIXME: use finger trees thoroughly *)
+          method catalog =
+            catalog_of branch
+            |> Result.map BatFingerTree.to_list (* FIXME: use finger trees thoroughly *)
         end ]
 
 let heads = Path.("system" @/ "branch" @/ this)
diff --git a/lib/kernel/SubstantialRelation.ml b/lib/kernel/SubstantialRelation.ml
index fe9e34f..3e7945d 100644
--- a/lib/kernel/SubstantialRelation.ml
+++ b/lib/kernel/SubstantialRelation.ml
@@ -19,6 +19,20 @@ module Make (S : Abstract.Storage.STORAGE) = struct
         "The tuple-set root for a substantial relation is missing from the backend. Either your \
          storage is corrupted, or this is a bug in RNT!"
         ("hash" |=| Concepts.Value.String (Concepts.Hash.to_hum_string root))
+
+    let missing_attribute name =
+      condition "missing-attribute" "A tuple to store has no value for an attribute of its relation"
+        ("attribute" |=| Concepts.Value.String name)
+
+    let unindexed_attribute name =
+      condition "unindexed-attribute" "A relation was looked up on an attribute it has no index for"
+        ("attribute" |=| Concepts.Value.String name)
+
+    let invalid_index_root root =
+      condition "invalid-index-root"
+        "An index root for a substantial relation is missing from the backend. Either your storage \
+         is corrupted, or this is a bug in RNT!"
+        ("hash" |=| Concepts.Value.String (Concepts.Hash.to_hum_string root))
   end
 
   module TupleKey = struct
@@ -42,8 +56,12 @@ module Make (S : Abstract.Storage.STORAGE) = struct
   end
 
   module TupleSet = Merkle.Interface (S) (TupleKey) (TupleValue)
+  module Index = Merkle.Make (S) (Merkle.StringKey)
 
-  type t = {schematics: Concepts.Hash.hash; tuples: TupleSet.address}
+  type t =
+    { schematics: Concepts.Hash.hash;
+      tuples: TupleSet.address;
+      indexes: Index.address BatMap.String.t }
 
   module rec Representation : (Concepts.Encoding.Record.S with type t = t) =
     Concepts.Encoding.Record.Make (Body)
@@ -54,16 +72,26 @@ module Make (S : Abstract.Storage.STORAGE) = struct
     let tag = 'R'
     let malformed = Error.malformed_relation
 
-    let fields {schematics; tuples} =
+    let fields {schematics; tuples; indexes} =
       let open Concepts.Encoding in
-      ["schema", Value.bencode_of_hash schematics; "tuples", Value.bencode_of_hash tuples]
+      [ "schema", Value.bencode_of_hash schematics;
+        "tuples", Value.bencode_of_hash tuples;
+        ( "indexes",
+          Bencode.Dict
+            (BatMap.String.bindings indexes |> List.map (fun (a, h) -> a, Value.bencode_of_hash h))
+        ) ]
 
     let of_fields fields =
       let open Utilities.Result in
       let open Concepts.Encoding in
       let* schematics = Bencode.field "schema" fields |>> Value.hash_of_bencode in
       let* tuples = Bencode.field "tuples" fields |>> Value.hash_of_bencode in
-      Ok {schematics; tuples}
+      let* indexes = Bencode.field "indexes" fields |>> Bencode.as_dict in
+      let* indexes =
+        List.map (fun (a, h) -> Value.hash_of_bencode h |> Result.map (fun h -> a, h)) indexes
+        |> Utilities.List.sequence
+      in
+      Ok {schematics; tuples; indexes= BatMap.String.of_list indexes}
   end
 
   let encode = Representation.to_blob
@@ -94,14 +122,40 @@ module Make (S : Abstract.Storage.STORAGE) = struct
     |> Utilities.List.sequence
     |> Result.map BatMap.String.of_list
 
-  let enumerate connection relation =
+  let prefix value =
+    Concepts.Encoding.Bencode.to_bytes (Concepts.Tuple.bencode_of_value value) |> Bytes.to_string
+
+  let reading connection start walk =
     let open Utilities.Result in
     let* tx = S.start_read connection in
     let close () = ignore (S.abort tx) in
-    let* node = tuple_node tx relation |> Result.map_error (fun c -> close (); c) in
-    Ok
-      (Generator.cursor_of ~finally:close (fun ~yield ->
-           TupleSet.iter tx (fun _ tuple -> yield tuple) node ) )
+    let* node = start tx |> Result.map_error (fun c -> close (); c) in
+    Ok (Generator.cursor_of ~finally:close (walk tx node))
+
+  let enumerate connection relation =
+    reading connection
+      (fun tx -> tuple_node tx relation)
+      (fun tx node ~yield -> TupleSet.iter tx (fun _ tuple -> yield tuple) node)
+
+  let lookup connection relation attribute value =
+    let open Utilities.Result in
+    let* root =
+      BatMap.String.find_opt attribute relation.indexes
+      |> Option.to_result ~none:(Error.unindexed_attribute attribute)
+    in
+    let prefix = prefix value in
+    reading connection
+      (fun tx -> Index.find tx root |>> Option.to_result ~none:(Error.invalid_index_root root))
+      (fun tx node ~yield ->
+        Index.fold_left ~from:prefix
+          ~until:(fun key -> not (String.starts_with ~prefix key))
+          tx
+          (fun read _ address ->
+            let* () = read in
+            let* tuple = SI.get_req tx (S.Hash address) |>> TupleValue.decode in
+            Ok (yield tuple) )
+          (Ok ()) node
+        |> Result.join )
 
   class substantial_relation connection value description =
     object (self)
@@ -118,11 +172,13 @@ module Make (S : Abstract.Storage.STORAGE) = struct
 
       method modes =
         Ok
-          Concepts.
-            [ Mode.mode [] Cardinality.Finite;
-              Mode.mode (List.map fst (BatMap.String.bindings description)) (Cardinality.bounded 1)
-            ]
+          Concepts.(
+            Mode.mode [] Cardinality.Finite
+            :: Mode.mode (List.map fst (BatMap.String.bindings description)) (Cardinality.bounded 1)
+            :: List.map (fun a -> Mode.mode [a] Cardinality.Finite) self#indexes )
 
+      method indexes = List.map fst (BatMap.String.bindings relation.indexes)
+      method lookup attribute value = lookup connection relation attribute value
       method describe () = Ok (Protocols.Schematics.Relation description)
       method enumerate = enumerate connection relation
 
@@ -130,6 +186,7 @@ module Make (S : Abstract.Storage.STORAGE) = struct
         [ Protocols.Addressable.make self;
           Protocols.Relation.make self;
           Protocols.Enumerable.make self;
+          Protocols.Indexed.make self;
           Protocols.Schematics.make self ]
 
       method hash = encode relation |> Concepts.Hash.hash_of_blob
@@ -141,13 +198,32 @@ module Make (S : Abstract.Storage.STORAGE) = struct
     |> Result.map (fun description ->
         new substantial_relation connection relation description |> Protocols.Handle.make )
 
+  let index tx attribute hashed =
+    let open Utilities.Result in
+    let* entries =
+      List.map
+        (fun (hash, tuple) ->
+          match BatMap.String.find_opt attribute tuple.Concepts.Tuple.attributes with
+          | Some value -> Ok (prefix value ^ Concepts.Hash.to_raw_string hash, hash)
+          | None -> Error (Error.missing_attribute attribute) )
+        hashed
+      |> Utilities.List.sequence
+    in
+    Index.of_list tx entries |> Result.map (fun node -> attribute, Index.hash_of node)
+
   let store tx description tuples =
     let open Utilities.Result in
     let* schematics = store_schema tx description in
-    let* node =
-      TupleSet.of_list tx (List.map (fun tuple -> Concepts.Tuple.hash tuple, tuple) tuples)
+    let hashed = List.map (fun tuple -> Concepts.Tuple.hash tuple, tuple) tuples in
+    let* node = TupleSet.of_list tx hashed in
+    let* indexes =
+      BatMap.String.bindings description
+      |> List.map (fun (attribute, _) -> index tx attribute hashed)
+      |> Utilities.List.sequence
+    in
+    let relation =
+      {schematics; tuples= TupleSet.hash_of node; indexes= BatMap.String.of_list indexes}
     in
-    let relation = {schematics; tuples= TupleSet.hash_of node} in
     let* _ = SI.store_blob tx (encode relation) in
     Ok relation
 
@@ -155,10 +231,8 @@ module Make (S : Abstract.Storage.STORAGE) = struct
     let open Utilities.Result in
     let* relation =
       SI.with_transaction connection (fun tx ->
-          let* tuples = TupleSet.empty_under tx in
-          let relation = {schematics; tuples} in
-          let* _ = SI.store_blob tx (encode relation) in
-          Ok relation )
+          let* description = schema_of tx schematics in
+          store tx description [] )
     in
     load connection relation
 end
diff --git a/lib/protocols/Directory.mli b/lib/protocols/Directory.mli
index 332b1b6..930bda1 100644
--- a/lib/protocols/Directory.mli
+++ b/lib/protocols/Directory.mli
@@ -9,4 +9,6 @@ val make : #implementation -> Handle.protocol
 val from : Handle.t -> t Handle.interface option
 val list : t Handle.interface -> (string BatFingerTree.t, Concepts.Condition.condition) result
 val find : t Handle.interface -> string -> (Handle.t option, Concepts.Condition.condition) result
-val children : Handle.t -> ((string * Handle.t) BatFingerTree.t, Concepts.Condition.condition) result
+
+val children :
+  Handle.t -> ((string * Handle.t) BatFingerTree.t, Concepts.Condition.condition) result
diff --git a/lib/protocols/Indexed.ml b/lib/protocols/Indexed.ml
new file mode 100644
index 0000000..7cf1ea3
--- /dev/null
+++ b/lib/protocols/Indexed.ml
@@ -0,0 +1,20 @@
+module Error = struct
+  open Concepts.Condition
+
+  let not_indexed () =
+    condition "not-indexed" "A handle was expected to carry the indexed protocol and did not" empty
+end
+
+class type implementation = object
+  method indexes : string list
+  method lookup : string -> Concepts.Value.value -> (Handle.t, Concepts.Condition.condition) result
+end
+
+type Handle.protocol += Indexed of implementation
+type t = implementation
+
+let make impl = Indexed (impl :> implementation)
+let from handle = Handle.into handle (function Indexed impl -> Some impl | _ -> None)
+let require handle = from handle |> Option.to_result ~none:(Error.not_indexed ())
+let indexes i = Handle.invoke i (fun o -> o#indexes)
+let lookup i attribute value = Handle.invoke i (fun o -> o#lookup attribute value)
diff --git a/lib/protocols/Indexed.mli b/lib/protocols/Indexed.mli
new file mode 100644
index 0000000..5c8d97d
--- /dev/null
+++ b/lib/protocols/Indexed.mli
@@ -0,0 +1,17 @@
+type t
+
+class type implementation = object
+  method indexes : string list
+  method lookup : string -> Concepts.Value.value -> (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 indexes : t Handle.interface -> string list
+
+val lookup :
+  t Handle.interface ->
+  string ->
+  Concepts.Value.value ->
+  (Handle.t, Concepts.Condition.condition) result