diff options
| author | Marcos Magueta <maguetamarcos@gmail.com> | 2026-09-26 13:22:10 -0300 |
|---|---|---|
| committer | Marcos Magueta <maguetamarcos@gmail.com> | 2026-09-26 13:22:10 -0300 |
| commit | 504e2d03a10f1641b36a9d5f127a18bc943562ce (patch) | |
| tree | 3cff1b25540fd01c2c583f47e3bf90363543b0b2 /lib/evaluators/Lambda.ml | |
| parent | 8ff6bd42c0708b35f3026633e99f109de1bec89e (diff) | |
| download | RNT-504e2d03a10f1641b36a9d5f127a18bc943562ce.tar.gz RNT-504e2d03a10f1641b36a9d5f127a18bc943562ce.zip | |
ephemeral relations as outputs of FOL and program overhaul
Diffstat (limited to '')
| -rw-r--r-- | lib/evaluators/Lambda.ml | 105 |
1 files changed, 0 insertions, 105 deletions
diff --git a/lib/evaluators/Lambda.ml b/lib/evaluators/Lambda.ml deleted file mode 100644 index d864ca1..0000000 --- a/lib/evaluators/Lambda.ml +++ /dev/null @@ -1,105 +0,0 @@ -module Error = struct - open Concepts.Condition - - let unknown_name name = - 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 - -(* A dummy untyped lambda calculus where constants are relations. We - 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 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 -and environment = value BatMap.String.t - -(* 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 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 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 - -let execute term = - let open Utilities.Result in - let* value = reduce 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 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 |
