From 584fbca6d920e9a9f91d451667f9380714ac2175 Mon Sep 17 00:00:00 2001 From: Marcos Magueta Date: Fri, 25 Sep 2026 21:51:33 -0300 Subject: dune fmt --- lib/evaluators/FOL.ml | 30 +++++++++++------------ lib/evaluators/Lambda.ml | 63 +++++++++++++++++++++++------------------------- 2 files changed, 44 insertions(+), 49 deletions(-) (limited to 'lib/evaluators') diff --git a/lib/evaluators/FOL.ml b/lib/evaluators/FOL.ml index eba57a1..4299524 100644 --- a/lib/evaluators/FOL.ml +++ b/lib/evaluators/FOL.ml @@ -9,8 +9,7 @@ module Error = struct condition "evaluation-cancelled" "An evaluation was stopped before it produced its result" empty end -type plan = Base of Protocols.Handle.t - | Project of plan * string BatFingerTree.t +type plan = Base of Protocols.Handle.t | Project of plan * string BatFingerTree.t module Program = Protocols.Program.Make (struct type t = plan @@ -20,21 +19,20 @@ let execute = let open Utilities.Result in function | Base relation_handle -> - Fun.protect - ~finally:(fun () -> Protocols.Handle.release relation_handle) - (fun () -> - let* enumerable = Protocols.Enumerable.require relation_handle in - Protocols.Enumerable.enumerate enumerable) + Fun.protect + ~finally:(fun () -> Protocols.Handle.release relation_handle) + (fun () -> + let* enumerable = Protocols.Enumerable.require relation_handle in + Protocols.Enumerable.enumerate enumerable ) | Project (_plan, _attributes) -> failwith "TODO" -class evaluator = object (self) - inherit Kernel.Lifecycle.null - inherit Kernel.Identity.of_id - - method to_string = "fol-evaluator" - - method invoke = execute - method protocols : Protocols.Handle.protocol list = [Program.make self] -end +class evaluator = + object (self) + inherit Kernel.Lifecycle.null + inherit Kernel.Identity.of_id + method to_string = "fol-evaluator" + method invoke = execute + method protocols : Protocols.Handle.protocol list = [Program.make self] + end let make () = new evaluator |> Protocols.Handle.make diff --git a/lib/evaluators/Lambda.ml b/lib/evaluators/Lambda.ml index 53b0301..d864ca1 100644 --- a/lib/evaluators/Lambda.ml +++ b/lib/evaluators/Lambda.ml @@ -5,13 +5,16 @@ module Error = struct condition "unknown-name" "A term named neither a bound variable nor a relation existing under this snapshot" ("name" |=| Concepts.Value.String name) + let not_applicable () = condition "not-applicable" "A term was applied to an argument, but it denotes a relation rather than an abstraction" empty + let unapplied_abstraction () = condition "unapplied-abstraction" "A program reduced to an abstraction, which names no relation to enumerate" empty + let cancelled () = condition "evaluation-cancelled" "An evaluation was stopped before it produced its result" empty end @@ -20,20 +23,14 @@ end look for a name in the environment first and resolved through the context otherwise, so the relations reachable under the snapshot are the outer environment every program is evaluated on *) -type term = - | Name of string - | Abstract of string * term - | Apply of term * term - +type term = Name of string | 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 = program end) -type value = - | Relation of Protocols.Handle.t - | Closure of string * term * environment +type value = Relation of Protocols.Handle.t | Closure of string * term * environment and environment = value BatMap.String.t (* let reduce context term = *) @@ -68,21 +65,22 @@ let reduce (Program (term, dir)) = 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 + 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 operator in - match operator with - | Relation _ -> Error (Error.not_applicable ()) - | Closure (binder, body, closed) -> - let* argument = eval env operand in - eval (BatMap.String.add binder argument closed) body + | Apply (operator, operand) -> ( + let* operator = eval env operator in + match operator with + | Relation _ -> Error (Error.not_applicable ()) + | Closure (binder, body, closed) -> + let* argument = eval env operand in + eval (BatMap.String.add binder argument closed) body ) in eval BatMap.String.empty term @@ -92,17 +90,16 @@ let execute term = match value with | Closure _ -> Error (Error.unapplied_abstraction ()) | Relation handle -> - let* enumerable = Protocols.Enumerable.require handle in - Protocols.Enumerable.enumerate enumerable + 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 to_string = "lambda-evaluator" - - method invoke program = execute program - method protocols : Protocols.Handle.protocol list = [Program.make self] -end +class evaluator = + object (self) + inherit Kernel.Lifecycle.null + inherit Kernel.Identity.of_id + method to_string = "lambda-evaluator" + method invoke program = execute program + method protocols : Protocols.Handle.protocol list = [Program.make self] + end let make () = new evaluator |> Protocols.Handle.make -- cgit v1.2.3