WIP forsake context

9 files changed, 66 insertions, 94 deletions

diff --git a/lib/abstract/Storage.ml b/lib/abstract/Storage.ml
index 19d6c5c..e921be9 100644
--- a/lib/abstract/Storage.ml
+++ b/lib/abstract/Storage.ml
@@ -1,8 +1,3 @@
-(* @needs Configuration *)
-(* @needs Condition *)
-(* @needs Hash *)
-(* @needs Representation *)
-
 module type STORAGE = sig
   type connection
   type transaction
diff --git a/lib/evaluators/FOL.ml b/lib/evaluators/FOL.ml
index 257ea86..b290e0a 100644
--- a/lib/evaluators/FOL.ml
+++ b/lib/evaluators/FOL.ml
@@ -16,7 +16,7 @@ module Program = Protocols.Program.Make (struct
   type t = plan
 end)
 
-let execute context =
+let execute =
   let open Utilities.Result in
   function
   | Base relation_handle ->
@@ -24,14 +24,14 @@ let execute context =
        ~finally:(fun () -> Protocols.Handle.release relation_handle)
        (fun () ->
          let* enumerable = Protocols.Enumerable.require relation_handle in
-         Protocols.Enumerable.enumerate enumerable context)
+         Protocols.Enumerable.enumerate enumerable)
   | Project (_plan, _attributes) -> failwith "TODO"
 
 class evaluator = object (self)
   inherit Kernel.Lifecycle.null
   inherit Kernel.Identity.of_id
 
-  method invoke ~program context = execute context program
+  method invoke = execute
   method protocols : Protocols.Handle.protocol list = [Program.make self]
 end
 
diff --git a/lib/evaluators/Lambda.ml b/lib/evaluators/Lambda.ml
index 7cb0248..48ae6ec 100644
--- a/lib/evaluators/Lambda.ml
+++ b/lib/evaluators/Lambda.ml
@@ -25,8 +25,10 @@ type term =
   | Abstract of string * term
   | Apply of term * term
 
+type program = Program of term * Protocols.Directory.t Protocols.Handle.interface
+
 module Program = Protocols.Program.Make (struct
-  type t = term
+  type t = program
 end)
 
 type value =
@@ -34,56 +36,67 @@ type value =
   | Closure of string * term * environment
 and environment = value BatMap.String.t
 
-let reduce context ~acquire term =
+(* let reduce context term = *)
+(*   let open Utilities.Result in *)
+(*   let rec eval environment term = *)
+(*     match context.Protocols.Context.status () with *)
+(*     | `Cancelled | `Exhausted -> Error (Error.cancelled ()) *)
+(*     | `Live -> *)
+(*        match term with *)
+(*        | Name name -> *)
+(*           begin match BatMap.String.find_opt name environment with *)
+(*            | Some value -> Ok value *)
+(*            | None -> *)
+(*               let* found = Runtime.Context.resolve context name in *)
+(*               let* handle = Option.to_result ~none:(Error.unknown_name name) found in *)
+(*               Ok (Relation handle) *)
+(*           end *)
+(*        | Abstract (binder, body) -> Ok (Closure (binder, body, environment)) *)
+(*        | Apply (operator, operand) -> *)
+(*           let* operator = eval environment operator in *)
+(*           match operator with *)
+(*           | Relation _ -> Error (Error.not_applicable ()) *)
+(*           | Closure (binder, body, closed) -> *)
+(*              let* argument = eval environment operand in *)
+(*              eval (BatMap.String.add binder argument closed) body *)
+(*   in *)
+(*   eval BatMap.String.empty term *)
+
+let reduce (Program (term, dir)) =
   let open Utilities.Result in
-  let rec eval environment term =
-    match context.Protocols.Context.status () with
-    | `Cancelled | `Exhausted -> Error (Error.cancelled ())
-    | `Live ->
-       match term with
-       | Name name ->
-          begin match BatMap.String.find_opt name environment with
-           | Some value -> Ok value
-           | None ->
-              let* found = Runtime.Context.resolve context name in
-              let* handle = Option.to_result ~none:(Error.unknown_name name) found in
-              Ok (Relation (acquire handle))
-          end
-       | Abstract (binder, body) -> Ok (Closure (binder, body, environment))
-       | Apply (operator, operand) ->
-          let* operator = eval environment operator in
-          match operator with
-          | Relation _ -> Error (Error.not_applicable ())
-          | Closure (binder, body, closed) ->
-             let* argument = eval environment operand in
-             eval (BatMap.String.add binder argument closed) body
+  let open Protocols in
+  let rec eval env term =
+    match term with
+    | Name name ->
+       begin
+         match BatMap.String.find_opt name env with
+         | Some value -> Ok value
+         | None ->
+            let* handle = Directory.find dir name |> fmap (Option.to_result ~none:(Error.unknown_name name)) in
+            Ok (Relation handle)
+       end
+    | Abstract (binder, body) -> Ok (Closure (binder, body, env))
+    | Apply (operator, operand) ->
+       let* operator = eval env operation in
+       match operator with
+       | Relation _ -> Error (Error.not_applicable ())
+       | _ -> failwith "TODO"
   in
   eval BatMap.String.empty term
 
-(* Every handle resolved during reduction is released once the result
-   has been enumerated and we keep a closure free to carry a relation
-   it did not resolve itself *)
-let execute context term =
+let execute term =
   let open Utilities.Result in
-  let acquired = ref [] in
-  let acquire handle =
-    acquired := handle :: !acquired;
-    handle
-  in
-  Fun.protect
-    ~finally:(fun () -> List.iter Protocols.Handle.release !acquired)
-    (fun () ->
-      let* value = reduce context ~acquire term in
-      match value with
-      | Closure _ -> Error (Error.unapplied_abstraction ())
-      | Relation handle ->
-         let* enumerable = Protocols.Enumerable.require handle in
-         Protocols.Enumerable.enumerate enumerable context)
+  let* value = reduce context term in
+  match value with
+  | Closure _ -> Error (Error.unapplied_abstraction ())
+  | Relation handle ->
+     let* enumerable = Protocols.Enumerable.require handle in
+     Protocols.Enumerable.enumerate enumerable
 
 class evaluator = object (self)
   inherit Kernel.Lifecycle.null
   inherit Kernel.Identity.of_id
-  method invoke ~program context = execute context program
+  method invoke program = execute program
   method protocols : Protocols.Handle.protocol list = [Program.make self]
 end
 
diff --git a/lib/protocols/Enumerable.ml b/lib/protocols/Enumerable.ml
index e78f265..53db834 100644
--- a/lib/protocols/Enumerable.ml
+++ b/lib/protocols/Enumerable.ml
@@ -9,7 +9,7 @@ module Error = struct
 end
 
 class type implementation = object
-  method enumerate : Context.t -> (Handle.t, Concepts.Condition.condition) result
+  method enumerate : (Handle.t, Concepts.Condition.condition) result
 end
 
 type Handle.protocol += Enumerable of implementation
@@ -18,4 +18,4 @@ type t = implementation
 let make impl = Enumerable (impl :> implementation)
 let from handle = Handle.into handle (function Enumerable impl -> Some impl | _ -> None)
 let require handle = from handle |> Option.to_result ~none:(Error.not_enumerable ())
-let enumerate i context = Handle.invoke i (fun o -> o#enumerate context)
+let enumerate i = Handle.invoke i (fun o -> o#enumerate)
diff --git a/lib/protocols/Enumerable.mli b/lib/protocols/Enumerable.mli
index 4a903f6..d2ab882 100644
--- a/lib/protocols/Enumerable.mli
+++ b/lib/protocols/Enumerable.mli
@@ -1,7 +1,7 @@
 type t
 
 class type implementation = object
-  method enumerate : Context.t -> (Handle.t, Concepts.Condition.condition) result
+  method enumerate : (Handle.t, Concepts.Condition.condition) result
 end
 
 val make : #implementation -> Handle.protocol
@@ -9,5 +9,4 @@ val from : Handle.t -> t Handle.interface option
 
 val require : Handle.t -> (t Handle.interface, Concepts.Condition.condition) result
 
-val enumerate :
-  t Handle.interface -> Context.t -> (Handle.t, Concepts.Condition.condition) result
+val enumerate : t Handle.interface -> (Handle.t, Concepts.Condition.condition) result
diff --git a/lib/protocols/Program.ml b/lib/protocols/Program.ml
index 49e6e2d..5b618e6 100644
--- a/lib/protocols/Program.ml
+++ b/lib/protocols/Program.ml
@@ -4,10 +4,7 @@ end
 
 module Make (P : PROGRAM) = struct
   class type implementation = object
-    method invoke :
-      program:P.t ->
-      Context.t ->
-      (Handle.t, Concepts.Condition.condition) result
+    method invoke : P.t -> (Handle.t, Concepts.Condition.condition) result
   end
 
   type Handle.protocol += Program of implementation
@@ -16,5 +13,5 @@ module Make (P : PROGRAM) = struct
 
   let make impl = Program (impl :> implementation)
   let from handle = Handle.into handle (function Program impl -> Some impl | _ -> None)
-  let invoke i ~program ctx = Handle.invoke i (fun o -> o#invoke ~program ctx)
+  let invoke i program = Handle.invoke i (fun o -> o#invoke program)
 end
diff --git a/lib/protocols/Program.mli b/lib/protocols/Program.mli
index 1d6c3ae..9cf4455 100644
--- a/lib/protocols/Program.mli
+++ b/lib/protocols/Program.mli
@@ -6,18 +6,11 @@ module Make (P : PROGRAM) : sig
   type t
 
   class type implementation = object
-    method invoke :
-      program:P.t ->
-      Context.t ->
-      (Handle.t, Concepts.Condition.condition) result
+    method invoke : P.t -> (Handle.t, Concepts.Condition.condition) result
   end
 
   val make : #implementation -> Handle.protocol
   val from : Handle.t -> t Handle.interface option
 
-  val invoke :
-    t Handle.interface ->
-    program:P.t ->
-    Context.t ->
-    (Handle.t, Concepts.Condition.condition) result
+  val invoke : t Handle.interface -> P.t -> (Handle.t, Concepts.Condition.condition) result
 end
diff --git a/lib/runtime/Context.ml b/lib/runtime/Context.ml
deleted file mode 100644
index 2189735..0000000
--- a/lib/runtime/Context.ml
+++ /dev/null
@@ -1,14 +0,0 @@
-module Error = struct
-  open Concepts.Condition
-
-  let not_a_directory segment =
-    condition "not-a-directory" "A path segment named an object with no Directory protocol"
-      ("segment" |=| Concepts.Value.String segment)
-end
-
-let resolve { Protocols.Context.root; _ } name = Kernel.Path.lookup root name
-
-let over ~snapshot ~root ?(cancelled = fun () -> false) () =
-  { Protocols.Context.snapshot
-  ; root
-  ; status = (fun () -> if cancelled () then `Cancelled else `Live) }
diff --git a/lib/runtime/Context.mli b/lib/runtime/Context.mli
deleted file mode 100644
index 214071b..0000000
--- a/lib/runtime/Context.mli
+++ /dev/null
@@ -1,11 +0,0 @@
-val resolve :
-  Protocols.Context.t ->
-  Kernel.Path.t ->
-  (Protocols.Handle.t option, Concepts.Condition.condition) result
-
-val over :
-  snapshot:Concepts.Hash.hash ->
-  root:Protocols.Handle.t ->
-  ?cancelled:(unit -> bool) ->
-  unit ->
-  Protocols.Context.t