From ca8c92915bd3a7fa19ef57b8bd5a9b3f16d05254 Mon Sep 17 00:00:00 2001 From: Marcos Magueta Date: Sun, 13 Sep 2026 14:27:37 -0300 Subject: fol evaluator --- lib/evaluators/FOL.ml | 40 ++++++++++++++++++++++++++++++++++++++++ lib/kernel/Initialization.ml | 12 +++++++++++- lib/kernel/Initialization.mli | 5 ++++- lib/protocols/Program.ml | 31 +++++++++++++++++-------------- lib/protocols/Program.mli | 36 +++++++++++++++++++----------------- 5 files changed, 91 insertions(+), 33 deletions(-) create mode 100644 lib/evaluators/FOL.ml (limited to 'lib') diff --git a/lib/evaluators/FOL.ml b/lib/evaluators/FOL.ml new file mode 100644 index 0000000..70cf9de --- /dev/null +++ b/lib/evaluators/FOL.ml @@ -0,0 +1,40 @@ +module Error = struct + open Concepts.Condition + + let unknown_relation name = + condition "unknown-relation" "A plan named a relation that does not exist under this snapshot" + ("name" |=| Concepts.Value.String name) + + let cancelled () = + condition "evaluation-cancelled" "An evaluation was stopped before it produced its result" empty +end + +type plan = Base of string + +module Program = Protocols.Program.Make (struct + type t = plan +end) + +let execute context = function + | Base name -> + let open Utilities.Result in + match context.Protocols.Context.status () with + | `Cancelled | `Exhausted -> Error (Error.cancelled ()) + | `Live -> + let* found = Runtime.Context.resolve context name in + let* handle = Option.to_result ~none:(Error.unknown_relation name) found in + Fun.protect + ~finally:(fun () -> Protocols.Handle.release handle) + (fun () -> + let* enumerable = Protocols.Enumerable.require handle in + Protocols.Enumerable.enumerate enumerable context) + +class evaluator = object (self) + inherit Kernel.Lifecycle.null + inherit Kernel.Identity.of_id + + method invoke ~program context = execute context program + method protocols : Protocols.Handle.protocol list = [Program.make self] +end + +let make () = new evaluator |> Protocols.Handle.make diff --git a/lib/kernel/Initialization.ml b/lib/kernel/Initialization.ml index d213b66..ae041fc 100644 --- a/lib/kernel/Initialization.ml +++ b/lib/kernel/Initialization.ml @@ -1,12 +1,22 @@ module Make (S : Abstract.Storage.STORAGE) = struct module BM = BranchManager.Make (S) - let initialize conn = + let initialize ?(evaluators = []) conn = let open Utilities.Result in let open Protocols in let root = Namespace.make () in let registry = Registry.from root |> Option.get in let* branch_manager = BM.make conn "rnt-head" in let* _ = Registry.update registry "branch" None (Some branch_manager) in + let evaluator_namespace = Namespace.make () in + let evaluator_registry = Registry.from evaluator_namespace |> Option.get in + let* _ = + List.fold_left + (fun acc (name, handle) -> + let* _ = acc in + Registry.update evaluator_registry name None (Some handle)) + (Ok true) evaluators + in + let* _ = Registry.update registry "evaluator" None (Some evaluator_namespace) in Ok root end diff --git a/lib/kernel/Initialization.mli b/lib/kernel/Initialization.mli index 104d523..926bbd8 100644 --- a/lib/kernel/Initialization.mli +++ b/lib/kernel/Initialization.mli @@ -1,3 +1,6 @@ module Make (S : Abstract.Storage.STORAGE) : sig - val initialize : S.connection -> (Protocols.Handle.t, Concepts.Condition.condition) result + val initialize : + ?evaluators:(string * Protocols.Handle.t) list -> + S.connection -> + (Protocols.Handle.t, Concepts.Condition.condition) result end diff --git a/lib/protocols/Program.ml b/lib/protocols/Program.ml index b82cafc..49e6e2d 100644 --- a/lib/protocols/Program.ml +++ b/lib/protocols/Program.ml @@ -1,17 +1,20 @@ -class type implementation = object - method entry_points : string BatFingerTree.t - - method invoke : - entry:string -> - bindings:Concepts.Tuple.t -> - Context.t -> - (Handle.t, Concepts.Condition.condition) result +module type PROGRAM = sig + type t end -type Handle.protocol += Program of implementation -type t = implementation +module Make (P : PROGRAM) = struct + class type implementation = object + method invoke : + program:P.t -> + Context.t -> + (Handle.t, Concepts.Condition.condition) result + end + + type Handle.protocol += Program of implementation -let make impl = Program (impl :> implementation) -let from handle = Handle.into handle (function Program impl -> Some impl | _ -> None) -let entry_points i = Handle.invoke i (fun o -> o#entry_points) -let invoke i ~entry ~bindings ctx = Handle.invoke i (fun o -> o#invoke ~entry ~bindings ctx) + type t = implementation + + 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) +end diff --git a/lib/protocols/Program.mli b/lib/protocols/Program.mli index a795f16..1d6c3ae 100644 --- a/lib/protocols/Program.mli +++ b/lib/protocols/Program.mli @@ -1,21 +1,23 @@ -type t +module type PROGRAM = sig + type t +end + +module Make (P : PROGRAM) : sig + type t + + class type implementation = object + method invoke : + program:P.t -> + Context.t -> + (Handle.t, Concepts.Condition.condition) result + end -class type implementation = object - method entry_points : string BatFingerTree.t - method invoke : - entry:string -> - bindings:Concepts.Tuple.t -> + 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 end - -val make : #implementation -> Handle.protocol -val from : Handle.t -> t Handle.interface option -val entry_points : t Handle.interface -> string BatFingerTree.t - -val invoke : - t Handle.interface -> - entry:string -> - bindings:Concepts.Tuple.t -> - Context.t -> - (Handle.t, Concepts.Condition.condition) result -- cgit v1.2.3