diff options
Diffstat (limited to 'lib/evaluators/Lambda.ml')
| -rw-r--r-- | lib/evaluators/Lambda.ml | 63 |
1 files changed, 30 insertions, 33 deletions
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 |
