4 files changed, 114 insertions, 0 deletions
diff --git a/lib/protocols/Context.ml b/lib/protocols/Context.ml
new file mode 100644
index 0000000..ea314a6
--- /dev/null
+++ b/lib/protocols/Context.ml
@@ -0,0 +1,30 @@
+module Error = struct
+  open Concepts.Condition
+
+  let unresolved name =
+    condition "unresolved-name" "A name did not resolve to any object reachable from this context"
+      ("name" |=| Concepts.Value.String name)
+end
+
+class type implementation = object
+  method resolve : string -> (Handle.t option, Concepts.Condition.condition) result
+  method cancelled : bool
+  method charge : int -> (unit, Concepts.Condition.condition) result
+  method nest : ?authority:string BatSet.t -> unit -> implementation
+end
+
+(* Unlike every other protocol here, a context is handed to [Program.invoke] directly rather than
+   looked up through [Handle.into], exactly as evaluators.org's pseudocode shows. It therefore needs
+   no extensible-variant constructor and [make] is a plain upcast. *)
+type t = implementation
+
+let make impl = (impl :> implementation)
+let resolve context name = context#resolve name
+let cancelled context = context#cancelled
+let charge context n = context#charge n
+let nest ?authority context = context#nest ?authority () |> make
+
+let require context name =
+  let open Utilities.Result in
+  let* found = resolve context name in
+  Option.to_result ~none:(Error.unresolved name) found
diff --git a/lib/protocols/Context.mli b/lib/protocols/Context.mli
new file mode 100644
index 0000000..ec585cd
--- /dev/null
+++ b/lib/protocols/Context.mli
@@ -0,0 +1,15 @@
+type t
+
+class type implementation = object
+  method resolve : string -> (Handle.t option, Concepts.Condition.condition) result
+  method cancelled : bool
+  method charge : int -> (unit, Concepts.Condition.condition) result
+  method nest : ?authority:string BatSet.t -> unit -> implementation
+end
+
+val make : #implementation -> t
+val resolve : t -> string -> (Handle.t option, Concepts.Condition.condition) result
+val require : t -> string -> (Handle.t, Concepts.Condition.condition) result
+val cancelled : t -> bool
+val charge : t -> int -> (unit, Concepts.Condition.condition) result
+val nest : ?authority:string BatSet.t -> t -> t
diff --git a/lib/protocols/Cursor.ml b/lib/protocols/Cursor.ml
new file mode 100644
index 0000000..7c976b9
--- /dev/null
+++ b/lib/protocols/Cursor.ml
@@ -0,0 +1,48 @@
+module Error = struct
+  open Concepts.Condition
+
+  let not_a_cursor () =
+    condition "not-a-cursor" "A handle was expected to carry the cursor protocol and did not" empty
+end
+
+type batch = {tuples: Concepts.Tuple.t BatFingerTree.t; exhausted: bool}
+
+class type implementation = object
+  method fetch : int -> (batch, Concepts.Condition.condition) result
+end
+
+type Handle.protocol += Cursor of implementation
+type t = implementation
+
+let make impl = Cursor (impl :> implementation)
+let from handle = Handle.into handle (function Cursor impl -> Some impl | _ -> None)
+let require handle = from handle |> Option.to_result ~none:(Error.not_a_cursor ())
+let fetch i limit = Handle.invoke i (fun o -> o#fetch limit)
+
+(* A scalar loop over a batching protocol. The buffer is per-call rather than per-cursor state, so
+   [next] stays a derived convenience and an implementation still writes exactly one method: the
+   cost is that a caller alternating [next] and [fetch] on one cursor sees the buffered tuples
+   dropped. Callers pick one or the other. *)
+let rec next i =
+  let open Utilities.Result in
+  (* TODO: fetch 1 and hand back its head. Because an empty non-exhausted batch means "ask again",
+     this loops until it either has a tuple or sees [exhausted]. That loop is unbounded by
+     construction, which is precisely the bounded-work property [fetch] has and [next] gives up --
+     which is why [next] is documented for small results and scalar loops, not for scans a host
+     needs to be able to cancel. *)
+  let* batch = fetch i 1 in
+  match BatFingerTree.front batch.tuples with
+  | Some (_, tuple) -> Ok (Some tuple)
+  | None -> if batch.exhausted then Ok None else next i
+
+let drain i ?(limit = 256) () =
+  let open Utilities.Result in
+  (* TODO: fetch [limit] at a time, appending each batch, until [exhausted]. Appending is
+     [BatFingerTree.append], which is logarithmic, so accumulating a large result does not degrade
+     the way repeated list concatenation would. *)
+  let rec loop tuples =
+    let* batch = fetch i limit in
+    let tuples = BatFingerTree.append tuples batch.tuples in
+    if batch.exhausted then Ok tuples else loop tuples
+  in
+  loop BatFingerTree.empty
diff --git a/lib/protocols/Cursor.mli b/lib/protocols/Cursor.mli
new file mode 100644
index 0000000..08c7628
--- /dev/null
+++ b/lib/protocols/Cursor.mli
@@ -0,0 +1,21 @@
+type batch =
+  {tuples: Concepts.Tuple.t BatFingerTree.t; exhausted: bool}
+
+type t
+
+class type implementation = object
+  method fetch : int -> (batch, 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 fetch : t Handle.interface -> int -> (batch, Concepts.Condition.condition) result
+
+val next : t Handle.interface -> (Concepts.Tuple.t option, Concepts.Condition.condition) result
+
+val drain :
+  t Handle.interface ->
+  ?limit:int ->
+  unit ->
+  (Concepts.Tuple.t BatFingerTree.t, Concepts.Condition.condition) result